Analysis
Preparazione dei dati
Serve scaricare il Million Song Subset e scaricare il musiXmatch Dataset che ha il testo delle canzoni come bag of words.
Il Million Song Subset è in formato hf5 invece il musiXmatch Dataset in un database sqlite. Quindi è meglio mettere tutto in un unico database principale, perciò va convertito il Million Song Subset in un file csv per poi unire i dati allo stesso database del musiXmatch Dataset.
Per convertire il dataset da hf5 a csv ho scritto un codice in python ( hdf5_to_csv.py ) perché con R ci sono dei problemi riguardo il formato hf5, come segnalato sul sito di riferimento del Million Song Subset:
“We planned to release a R wrapper and looked at the default HDF5 library for R on Ubuntu. Unfortunately, it crashes on empty arrays. This happens when a track has no musicbrainz tag, for instance. If any R specialist is willing to help us with this, please contact us!”
library(readr)
library(RSQLite)
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union# aggiunto variabile prepareData in modo da poter eseguire l'inserimento dei dati nel database solo se il valore è TRUE (questo perché i dati potrebbero essere già stati "preparati")
prepareData<-FALSE # se TRUE allora inserisci i dati in database
millionSong<-read_csv("data/songs.csv")## Parsed with column specification:
## cols(
## .default = col_double(),
## song_number = col_integer(),
## artist_id = col_character(),
## artist_mbid = col_character(),
## artist_playmeid = col_integer(),
## artist_7digitalid = col_integer(),
## artist_location = col_character(),
## artist_name = col_character(),
## release = col_character(),
## release_7digitalid = col_integer(),
## song_id = col_character(),
## title = col_character(),
## track_7digitalid = col_integer(),
## analysis_sample_rate = col_integer(),
## audio_md5 = col_character(),
## key = col_integer(),
## mode = col_integer(),
## time_signature = col_integer(),
## track_id = col_character(),
## year = col_integer()
## )## See spec(...) for full column specifications.dim(millionSong)## [1] 10000 34head(millionSong)## # A tibble: 6 x 34
## song_number artist_familiari~ artist_hotttnes~ artist_id artist_mbid
## <int> <dbl> <dbl> <chr> <chr>
## 1 0 0.582 0.402 b'ARD7TVE~ b'e77e51a5-47~
## 2 1 0.631 0.417 b'ARMJAGH~ b'1c78ab62-db~
## 3 2 0.487 0.343 b'ARKRRTF~ b'7a273984-ed~
## 4 3 0.630 0.454 b'AR7G5I4~ b'e188a520-9c~
## 5 4 0.651 0.402 b'ARXR32B~ b'c6903a2e-06~
## 6 5 0.535 0.385 b'ARKFYS9~ b'79c403f9-54~
## # ... with 29 more variables: artist_playmeid <int>,
## # artist_7digitalid <int>, artist_latitude <dbl>,
## # artist_longitude <dbl>, artist_location <chr>, artist_name <chr>,
## # release <chr>, release_7digitalid <int>, song_id <chr>,
## # song_hotttnesss <dbl>, title <chr>, track_7digitalid <int>,
## # analysis_sample_rate <int>, audio_md5 <chr>, danceability <dbl>,
## # duration <dbl>, end_of_fade_in <dbl>, energy <dbl>, key <int>,
## # key_confidence <dbl>, loudness <dbl>, mode <int>,
## # mode_confidence <dbl>, start_of_fade_out <dbl>, tempo <dbl>,
## # time_signature <int>, time_signature_confidence <dbl>, track_id <chr>,
## # year <int>C’è un problema con le colonne di tipo stringa: ci sono due caratteri all’inizio ed uno alla fine che vanno rimossi.
# recupera le colonne di tipo stringa
columnsTypes<-sapply(millionSong,class)
(stringColumns<-names(columnsTypes[columnsTypes=='character']))## [1] "artist_id" "artist_mbid" "artist_location" "artist_name"
## [5] "release" "song_id" "title" "audio_md5"
## [9] "track_id"head(millionSong[,stringColumns])## # A tibble: 6 x 9
## artist_id artist_mbid artist_location artist_name release song_id title
## <chr> <chr> <chr> <chr> <chr> <chr> <chr>
## 1 b'ARD7TVE~ b'e77e51a5~ b'California -~ b'Casual' b'Fear~ b'SOMZ~ "b\"~
## 2 b'ARMJAGH~ b'1c78ab62~ b'Memphis, TN' b'The Box ~ b'Dime~ b'SOCI~ b'So~
## 3 b'ARKRRTF~ b'7a273984~ b'' b'Sonora S~ b'Las ~ b'SOXV~ b'Am~
## 4 b'AR7G5I4~ b'e188a520~ b'London, Engl~ b'Adam Ant' b'Frie~ b'SONH~ b'So~
## 5 b'ARXR32B~ b'c6903a2e~ b'' b'Gob' b'Muer~ b'SOFS~ b'Fa~
## 6 b'ARKFYS9~ b'79c403f9~ b'' b'Jeff And~ b'Ordi~ b'SOYM~ b'Th~
## # ... with 2 more variables: audio_md5 <chr>, track_id <chr># rimuovi i primi due caratteri e l'ultimo per i valori delle colonne di tipo stringa
for(stringColumn in stringColumns){
values<-millionSong[,stringColumn][[stringColumn]]
millionSong<-mutate(millionSong, !!stringColumn:=substr(values,3,nchar(values)-1))
}
head(millionSong[,stringColumns])## # A tibble: 6 x 9
## artist_id artist_mbid artist_location artist_name release song_id title
## <chr> <chr> <chr> <chr> <chr> <chr> <chr>
## 1 ARD7TVE11~ e77e51a5-4~ California - LA Casual Fear I~ SOMZWC~ I Di~
## 2 ARMJAGH11~ 1c78ab62-d~ Memphis, TN The Box To~ Dimens~ SOCIWD~ Soul~
## 3 ARKRRTF11~ 7a273984-e~ "" Sonora San~ Las Nu~ SOXVLO~ Amor~
## 4 AR7G5I411~ e188a520-9~ London, England Adam Ant Friend~ SONHOT~ Some~
## 5 ARXR32B11~ c6903a2e-0~ "" Gob Muerto~ SOFSOC~ Face~
## 6 ARKFYS911~ 79c403f9-5~ "" Jeff And S~ Ordina~ SOYMRW~ The ~
## # ... with 2 more variables: audio_md5 <chr>, track_id <chr># inserisci i dati nello stesso database che ha il testo delle canzoni
dbCon <- dbConnect(RSQLite::SQLite(), "data/mxm_dataset.db")
if(prepareData){
dbWriteTable(dbCon,"songs",millionSong)
}
dbListTables(dbCon)## [1] "jam_msd" "jams" "likes" "lyrics" "song_tag" "songs"
## [7] "userTaste" "words"Serve scaricare il last.fm Dataset che ha i dati riguardo i tag di ciascuna canzone.
Si tratta di un database sqlite, quindi si copiano i dati nel database principale.
Ci sono 3 tabelle: una tabella di legame (tid_tag) che contiene i ROWID della canzone e del tag collegati e le altre due contengono una l’id della canzone e l’altra il tag. Si usa una query select con due join in modo da avere per ogni record l’id della canzone, il tag e la confidenze. Ci sono molti record, quindi si esegue la query a blocchi.
size<-10000
songTagsCon <- dbConnect(RSQLite::SQLite(), "data/lastfm_tags.db")
tables<-dbListTables(songTagsCon)
if(prepareData){
rs <- dbSendQuery(songTagsCon, "select song.tid,tag.tag,song_tag.val from tids song
join tid_tag song_tag on song.ROWID=song_tag.tid
join tags tag on tag.ROWID=song_tag.tag")
i<-0
while (!dbHasCompleted(rs)) {
print(i)
i<-i+1
df <- dbFetch(rs, n = size)
dbWriteTable(dbCon,"song_tag",df,append=TRUE)
}
dbClearResult(rs)
}Serve scaricare il Taste Profile dataset riguardo i gusti degli utenti, si hanno i dati riguardo quante volte un utente ha ascoltato una certa canzone. Si tratta di un file di testo in formato tsv, quindi si copiano i dati nel database principale. Ci sono tanti record, ancora di più rispetto al caso precedente quindi per copiare i dati si usa direttamente sqlite. Si crea la tabella userTaste con 3 colonne (user_id e song_id di tipo testo e play_count di tipo intero) e poi si importano i dati dal file eseguendo il comando “.import”data/train_triplets.txt" userTaste“.
if(prepareData){
dbExecute(dbCon,"CREATE TABLE userTaste (user_id TEXT, song_id TEXT, play_count INTEGER);")
}Serve scaricare il Thisismyjam datadump che ha i dati riguardo i jam creati dagli utenti per le canzoni ed i like che gli utenti hanno dato. I dati sono in file di testo in formato tsv, si legge un file di testo alla volta per creare una tabella nel database principale.
if(prepareData){
jams<-read_tsv("data/thisismyjam-datadump/archive/jams.tsv")
likes<-read_tsv("data/thisismyjam-datadump/archive/likes.tsv")
dbWriteTable(dbCon,"jams",jams)
dbWriteTable(dbCon,"likes",likes)
}I jam si riferiscono ad una canzone tramite un id che non combacia con quello usato nel Million Song Subset, per questo motivo si usa thisismyjam-to-MSD che è un file tsv con la mappatura corretta.
if(prepareData){
jam_msd<-read_tsv("data/jam_to_msd.tsv",col_names=c("jam_id","track_id"))
dbWriteTable(dbCon,"jam_msd",jam_msd)
}
dbListTables(dbCon)## [1] "jam_msd" "jams" "likes" "lyrics" "song_tag" "songs"
## [7] "userTaste" "words"Analisi esplorativa sui dati delle canzoni
Per cominciare è utile visualizzare come sono distribuite nel corso del tempo le canzoni del dataset, quindi raggruppare le canzoni secondo l’anno e fare un grafico secondo il numero di canzoni in ciascun anno.
library(ggplot2)
songs <- tbl(dbCon, "songs")
# funzione di utility per dare il plot del numero di canzoni raggruppate secondo groupValue
plotCountBy<-function(songs,groupName){
# esegui la query con dplyr, conta il numero di canzoni per ogni gruppo (groupValue)
songsByGroup<-songs %>%
group_by(groupValue) %>%
summarise(count = n()) %>%
collect()
ggplot(songsByGroup,aes(x=groupValue,y=count))+
geom_col()+
xlab(groupName)
}
plotCountBy(songs %>% mutate(groupValue=year),"anno")
Come prima cosa si nota che la maggior parte delle canzoni risulta nell’anno 0, il che in realtà significa che per la maggior parte delle canzoni non si ha il dato relativo all’anno.
songs %>% group_by(year) %>% summarise(count=n()) %>%
collect %>% # usa collect perché sqlite non supporta la funzione sum, quindi recupera i dati per fare sum in r
filter(sum(count)>0) %>% # non considerare anni senza canzoni
mutate(count=count/sum(count)) %>% arrange(desc(count))## # A tibble: 69 x 2
## year count
## <int> <dbl>
## 1 0 0.532
## 2 2006 0.0320
## 3 2005 0.0304
## 4 2007 0.0285
## 5 2004 0.0270
## 6 2003 0.0254
## 7 2008 0.0253
## 8 2009 0.0250
## 9 2001 0.0217
## 10 2002 0.0198
## # ... with 59 more rowsEscludendo dal grafico queste canzoni si ha:
# escludi le canzoni con year==0, sono canzoni delle quali non si sa l'anno
plotCountBy(songs %>% filter(year!=0) %>% mutate(groupValue=year),"anno")
Si può notare che la maggior parte delle canzoni, di cui si sa l’anno, è distribuita soprattutto attorno al 2000. La canzone più vecchia è del 1926. Al posto di ragguppare le canzoni secondo l’anno può risultare più utile considerare il decennio, ad esempio una canzone del 1986 appartiene al decennio 1980-1990 quindi verrà associata al decennio 1980.
if(prepareData){
dbExecute(dbCon, "ALTER TABLE songs ADD COLUMN decade INTEGER")
# inserisci i dati
# in sqlite non esiste la funzione floor(x) quindi si può usare cast(x as integer) (attenzione che non funziona se x<0, andrebbe usata round(x-0.5))
dbExecute(dbCon, "UPDATE songs SET decade = cast((year/10)*10 as integer)")
}
songs<-tbl(dbCon,"songs")
plotCountBy(songs %>% filter(decade!=0) %>% mutate(groupValue=decade),"decade")
Visualizza l’uso delle diverse chiavi musicali nel corso del tempo
plotCountByRelative<-function(songs,mainGroupName,secondGroupName){
songsByGroup<-songs %>%
group_by(mainGroupValue) %>%
summarise(count = n()) %>%
collect()
# run a query in dplyr, count number of songs for each key
songsByBothGroups<-songs %>%
group_by(mainGroupValue,secondGroupValue) %>%
summarise(count = n()) %>%
collect()
# consider the relative value: so divide the number of song with a second group for each main group by the number of songs of that main group
songsByBothGroups<-songsByBothGroups %>% inner_join(songsByGroup,by="mainGroupValue") %>% mutate(val=count.x/count.y)
ggplot(songsByBothGroups,aes(x=mainGroupValue,y=val,fill=factor(secondGroupValue)))+
geom_col()+
labs(x=mainGroupName,fill=secondGroupName)
}
plotCountByRelative(songs %>% filter(year!=0) %>% mutate(mainGroupValue=year,secondGroupValue=key),"year","key")
Visualizza correlazione tra variabili riguardanti il cantante e la canzone
data_sub<-songs %>% select(artist_familiarity,artist_hotttnesss,artist_latitude,artist_longitude,song_hotttnesss,duration,loudness,year) %>% collect()
pairs(data_sub)
pairs(data_sub %>% filter(year>0))
Artist hottness e artist familiarity sono molto correlati tra loro, anche con song hottness. Sembra che artista nell’emisfero sud (latitude<0) hanno stesso valore di hotness (circa 0.5) e per longitude>0 stessa situazione (quindi è possibile avere valori estremi di hotness principalmente negli us). Inoltre la maggior parte delle canzoni è di artisti con latitude>0 e longitude<0 (cioè di nuovo us) All aumentare degli anni ci sono canzoni con sempre più loudness e sembra anche (meno evidente) con più durata.
Visualizza meglio la correlazione tra artist hottness, artist familiarity e song hottness.
ggplot(data_sub %>% filter(!is.na(song_hotttnesss)),aes(x=artist_familiarity,y=artist_hotttnesss,color=song_hotttnesss))+
geom_point()## Warning: Removed 1 rows containing missing values (geom_point).
Controlla osservazioni fatte riguardo posizione geografica dell’artista.
library(ggmap)
library(maps)
library(mapdata)
world_data <- map_data("world") # dati per la mappa di tutto il mondo centrata nell'oceano pacifico
ggplot() + geom_polygon(data = world_data, aes(x=long, y = lat, group = group)) +
coord_fixed(1.3)+
geom_point(data=data_sub,aes(x=artist_longitude,y=artist_latitude,color=artist_hotttnesss))## Warning: Removed 6258 rows containing missing values (geom_point).
COnsidera per ciascun artista la media di song_hotness e l’anno della prima canzone.
# ci sono artisti associati a posizioni geografiche diverse
artists<-songs %>%
collect %>% # usa collect perché altrimenti non funziona l'uso di n_distinct
group_by(artist_name) %>%
summarise(p=n_distinct(artist_latitude,artist_longitude)) %>% filter(p>1) %>% inner_join(songs,copy=T) %>% select(artist_name,title,year,artist_latitude,artist_longitude)## Joining, by = "artist_name"data_sub<-songs %>% group_by(artist_id,artist_latitude,artist_longitude) %>% summarise(song_hotttnesss=mean(song_hotttnesss),min_year=min(year),max_year=max(year),artist_familiarity=mean(artist_familiarity),artist_hotttnesss=mean(artist_hotttnesss))
ggplot(data_sub %>% collect ,aes(x=artist_hotttnesss,y=song_hotttnesss))+
geom_point()## Warning: Missing values are always removed in SQL.
## Use `AVG(x, na.rm = TRUE)` to silence this warning## Warning: Missing values are always removed in SQL.
## Use `MIN(x, na.rm = TRUE)` to silence this warning## Warning: Missing values are always removed in SQL.
## Use `MAX(x, na.rm = TRUE)` to silence this warning## Warning: Missing values are always removed in SQL.
## Use `AVG(x, na.rm = TRUE)` to silence this warning
## Warning: Missing values are always removed in SQL.
## Use `AVG(x, na.rm = TRUE)` to silence this warning## Warning: Removed 1130 rows containing missing values (geom_point).
data_sub<-songs %>% group_by(artist_id,artist_latitude,artist_longitude) %>% summarise(artist_hotttnesss=mean(artist_hotttnesss),song_hotttnesss=mean(song_hotttnesss),min_year=min(year)) %>% collect## Warning: Missing values are always removed in SQL.
## Use `AVG(x, na.rm = TRUE)` to silence this warning## Warning: Missing values are always removed in SQL.
## Use `AVG(x, na.rm = TRUE)` to silence this warning## Warning: Missing values are always removed in SQL.
## Use `MIN(x, na.rm = TRUE)` to silence this warningggplot() + geom_polygon(data = world_data, aes(x=long, y = lat, group = group)) +
coord_fixed(1.3)+
geom_point(data=data_sub,aes(x=artist_longitude,y=artist_latitude,color=artist_hotttnesss))## Warning: Removed 2493 rows containing missing values (geom_point).
ggplot() + geom_polygon(data = world_data, aes(x=long, y = lat, group = group)) +
coord_fixed(1.3)+
geom_point(data=data_sub %>% filter(!is.na(song_hotttnesss)),aes(x=artist_longitude,y=artist_latitude,color=song_hotttnesss))## Warning: Removed 1718 rows containing missing values (geom_point).
ggplot() + geom_polygon(data = world_data, aes(x=long, y = lat, group = group)) +
coord_fixed(1.3)+
geom_point(data=data_sub %>% filter(min_year>0&min_year<1990),aes(x=artist_longitude,y=artist_latitude,color=min_year))## Warning: Removed 116 rows containing missing values (geom_point).
La maggior parte di canzoni è associata a cantanti negli Stati Uniti e poi in Europa, anche le canzoni più vecchie appartengono a questo gruppo.
not_us_europe<-songs %>% filter(artist_latitude<10|(artist_longitude>-20&artist_latitude<30)|artist_longitude< -150) %>% arrange(artist_longitude) %>% select(artist_name,artist_longitude,artist_latitude)Controlla l’andamento di loudness e duration con il passare del tempo
library(tidyr)
data_sub<-songs %>% filter(year>0) %>% select(loudness,duration,year) %>% mutate(loudness=-loudness) %>% collect %>% gather(measure,value,-year)
ggplot(data_sub ,aes(x=year,y=value))+
geom_point()+
facet_wrap(~measure,scales = "free")
Analisi sul testo delle canzoni
Si considera oltre ai dati sulle canzoni anche il testo corrispondente; non si ha il testo per tutte le canzoni, quindi si verifica se le osservazioni fatte considerando tutte le canzoni rimangono valide.
songs_lyrics<-dbGetQuery(dbCon,'select * from songs join lyrics on songs.track_id=lyrics.track_id')
songs_lyrics<-songs_lyrics[,unique(colnames(songs_lyrics))]
length(unique(songs_lyrics$track_id))## [1] 2350plotCountBy(songs_lyrics %>% filter(year!=0) %>% mutate(groupValue=year),"anno")
Per quanto riguarda il numero di canzoni raggruppate per anno l’andamento è abbastanza simile nonostante si stiano considerando solo le canzoni che hanno un testo associato.
Verifica la correlazione tra artist familiarity, artist hottness e song_hottness
ggplot(songs_lyrics %>% filter(!is.na(song_hotttnesss)),aes(x=artist_familiarity,y=artist_hotttnesss,color=song_hotttnesss))+
geom_point()
Anche in questo caso rimane valida l’osservazione fatta considerando tutte le canzoni.
Infine si visualizza la disposizione geografica dei cantanti
data_sub<-songs_lyrics %>% group_by(artist_id,artist_latitude,artist_longitude) %>% summarise(artist_hotttnesss=mean(artist_hotttnesss),song_hotttnesss=mean(song_hotttnesss),min_year=min(year)) %>% collect
ggplot() + geom_polygon(data = world_data, aes(x=long, y = lat, group = group)) +
coord_fixed(1.3)+
geom_point(data=data_sub,aes(x=artist_longitude,y=artist_latitude,color=artist_hotttnesss))## Warning: Removed 777 rows containing missing values (geom_point).
Eccetto il fatto che ci sono meno canzoni ed anche ancora meno canzoni con i dati della latitudine e longitudine rimane una grande concentrazione di canzoni associate agli Stati Uniti e all’Europa.
Da quante parole è formate una canzone?
# funzioni ausiliarie
# numero totale di parole, numero di parole diverse, diversità (numero parole diverse/totale parole)
getWordsCount<-function(songs){
return(songs %>% group_by(songId) %>% summarise(total_words=sum(count),different_words=n(),diversity=different_words/total_words))
}
wordsForSong<-songs_lyrics %>% mutate(songId=track_id) %>% getWordsCount
summary(wordsForSong)## songId total_words different_words diversity
## Length:2350 Min. : 2.0 Min. : 2.00 Min. :0.05512
## Class :character 1st Qu.: 138.0 1st Qu.: 57.00 1st Qu.:0.31106
## Mode :character Median : 204.0 Median : 78.00 Median :0.39162
## Mean : 234.8 Mean : 86.57 Mean :0.40917
## 3rd Qu.: 288.0 3rd Qu.:102.00 3rd Qu.:0.49138
## Max. :1415.0 Max. :372.00 Max. :1.00000wordsForSong %>% gather(measure,value,-songId) %>% mutate(measure=factor(measure,levels=c("total_words","different_words","diversity"))) %>%
ggplot(aes(x=value))+
geom_histogram()+
facet_wrap(~measure,scales = "free")## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
# aggiungi le colonne anche al dataframe con tutte le canzoni che hanno il testo
songs_with_lyrics<-songs %>% inner_join(wordsForSong,by=c("track_id"="songId"),copy=T) %>% collectIl numero di parole che formano una canzone nel corso del tempo.
data<-songs_with_lyrics%>% filter(year>1970) %>%
mutate(year=factor(year))
ggplot(data,aes(x=year,y=total_words))+
geom_boxplot()
ggplot(data,aes(x=year,y=different_words))+
geom_boxplot()
ggplot(data,aes(x=year,y=diversity))+
geom_boxplot()
Vediamo la distribuzione del numero totale delle parole rispetto alla diversità del loro uso, considerando anche la popolarità dell’artista della canzone.
library(ggExtra)
data<-songs_with_lyrics %>% filter(!is.na(song_hotttnesss))
p<-ggplot(data,aes(x=diversity,y=total_words,color=song_hotttnesss))+
geom_point()
ggMarginal(p,data,type = "histogram")
p
#songs_with_text %>% select(total_words,different_words,diversity_words,time_signature,year,artist_familiarity,artist_hotttnesss,loudness,duration,key,tempo) %>% pairsQuali parole sono più usate?
library(tidytext)
library(wordcloud)## Loading required package: RColorBrewerwords<-songs_lyrics %>% group_by(word) %>% summarise(count=sum(count))
dim(words)## [1] 4851 2# elimina le stop words
w<-words %>% anti_join(stop_words)## Joining, by = "word"wordcloud(w$word,w$count,max.words = 100)
ggplot(words %>% arrange(desc(count)) %>% top_n(10),aes(x=word,y=count))+
geom_col()## Selecting by count
ggplot(words %>% anti_join(stop_words) %>% arrange(desc(count)) %>% top_n(10),aes(x=word,y=count))+
geom_col()## Joining, by = "word"## Selecting by count
Quali parole sono più usate, in base all’anno?
library(tidytext)
words<-songs_lyrics %>% group_by(word,year) %>% summarise(count=sum(count))
wordsForYear<-words %>% filter(year>1970 && nchar(word)>3) %>% anti_join(stop_words) %>% group_by(word,year) %>% summarise(count=sum(count)) %>% group_by(year) %>% arrange(desc(count)) %>% top_n(10) %>% select(c("year","word","count"))## Joining, by = "word"## Selecting by countwordsForYear$word<-factor(wordsForYear$word)
ggplot(wordsForYear,aes(x=word,y=count))+
geom_col()+
facet_wrap(~year,ncol=1,scales = "free")+
coord_flip()
Parole più usate per anno, wordcloud
library(wordcloud)
wordsForYear<-words %>% filter(year>1970&&nchar(word)>3) %>% anti_join(stop_words) %>% group_by(word,year) %>% summarise(count=sum(count)) %>% group_by(year) %>% arrange(desc(count)) %>% select(c("year","word","count"))## Joining, by = "word"years<-wordsForYear %>% distinct(year) %>% arrange(year)
for(yearVal in years$year){
words_year<-wordsForYear %>% filter(year==yearVal)
wordcloud(words_year$word,words_year$count,max.words = 30, main=yearVal)
}
Le parole più usate e durature con il passare degli anni
# parole apparse nel corso degli anni
words<-songs_lyrics %>% group_by(word,year) %>% summarise(count=sum(count))
# considera il numero di parole totali e canzoni totali per anno, in modo da poter considerare il valore relativo del numero di parole rispetto al numero di parole totali o numero di canzoni totali per anno
songs_words_byYear<-songs_lyrics %>% group_by(year) %>% summarise(total_words=sum(count),total_songs=n_distinct(track_id))
# calcola valore relativo rispetto numero totale di parole per anno
words<-words %>% inner_join(songs_words_byYear,by="year") %>% mutate(word_words=count,word_songs=count)
# parole rimaste usate nel corso del tempo
words_during_time<-words %>% filter(nchar(word)>3) %>% anti_join(stop_words) %>% group_by(word) %>% summarise(usage=sum(word_songs)) %>% arrange(desc(usage)) %>% top_n(10) %>% select(word)## Joining, by = "word"## Selecting by usage# prepara dataframe per il plot: per ciascun anno quanto è usata ciascuna parola "duratura" nel tempo
words_year<-songs_lyrics %>% distinct(year) %>% merge(words_during_time)
words<-words_year %>% inner_join(words,by=c("word","year"))
w<-words %>% group_by(year) %>% summarise(total_word_songs=sum(word_songs))
w<-words %>% inner_join(w) %>% mutate(word_songs=word_songs/total_word_songs)## Joining, by = "year"ggplot(w %>% filter(year>0),aes(word,year))+
geom_tile(aes(fill=word_songs))
#ggplot(words,aes(x=word,y=word_songs))+
# geom_col()+
# facet_wrap(~year,ncol=1,scales="free")Visualizza l’uso di una specifica parola nel corso degli anni
wordVal<-"love"
ggplot(words %>% filter(year>1960&word==wordVal),aes(x=year,y=word_songs,fill=word))+
geom_col(position = "dodge")
Sentiment analysis
Per cercare di estrapolare informazioni riguardo le emozioni espresse in una canzone si applica una sentiment analysis. Avendo a disposizione il testo delle canzoni in formato bag of words si può associara a ciascuna parola il sentimento più affine. Per fare questo si usano dei dizionari di parole che contengono varie parole con il sentimento ad esse più affine ( sentiment lexicon ). In r si ha a disposizione tramite il pacchetto tidytext vari lexicon possibili. Verifica in quante canzoni si trovano parole associate ad un sentimento secondo i vari lexicon.
lexicons<-c("loughran","bing","nrc")
for(l in lexicons){
# print(l)
# print(get_sentiments(l) %>% distinct(sentiment))
sentimentWords<-get_sentiments(l)
song_sentiment<-songs_lyrics %>% inner_join(sentimentWords)
print(paste(l,song_sentiment %>% distinct(track_id) %>% nrow))
}## Joining, by = "word"## [1] "loughran 1905"## Joining, by = "word"## [1] "bing 2200"## Joining, by = "word"## [1] "nrc 2260"I lexicon loughran e nrc associano le parole a vari sentimenti invece bing solo a due, cioè distingue le parole in positive o negative. loughran non ha molte corrispondenze con le parole nei testi delle canzoni rispetto agli altri due, quindi non viene considerato, si usa bing ed nrc.
Distribuzione nel corso degli anni delle parole positive e negative
songWords<-songs_lyrics %>% group_by(word) %>% mutate(count=sum(count))
w<-songWords %>% group_by(year) %>% summarise(totalWords=sum(count),differentWords=n())
sentimentWords<-get_sentiments("bing")
songWords<-songWords %>% left_join(sentimentWords)## Joining, by = "word"songSentiment<-songWords %>% group_by(year,sentiment)
songSentimentSummary<-songSentiment %>% summarise(total=sum(count),different=n()) %>%
left_join(w, by = "year") %>%
mutate(total = total/totalWords,different=different/differentWords) %>%
arrange(desc(year))
# considera tutte le occorrenze delle parole
ggplot(songSentimentSummary %>% filter(year>0& !is.na(sentiment)),aes(x=year,y=total,fill=sentiment))+
geom_col()
Il numero di parole associate a sentimenti positivi sono in numero maggiore rispetto alle parole associate a sentimenti nagativi, inoltre questo vale per praticamente qualsiasi anno.
data<-songSentimentSummary %>% select(year,sentiment,total) %>% spread(sentiment,total)
data <- data%>% mutate(ratio=positive/negative)
ggplot(data,aes(x=ratio))+
geom_histogram()+
scale_x_continuous(breaks = seq(0,70,5))## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Considerando il numero di parole diverse associate a sentimenti positivi ed il numero di parole diverse associate a sentimenti negativi si ottiene:
# considera numero di parole diverse
ggplot(songSentimentSummary %>% filter(year>0& !is.na(sentiment)),aes(x=year,y=different,fill=sentiment))+
geom_col()
In questo caso il numero di parole diverse associate a sentimenti positivi è approssimativamente lo stesso delle parole diverse associate a sentimenti negativi.
data<-songSentimentSummary %>% select(year,sentiment,different) %>% spread(sentiment,different)
data <- data%>% mutate(ratio=positive/negative)
ggplot(data,aes(x=ratio))+
geom_histogram()+
scale_x_continuous(breaks=(0:8))## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Il numero di parole diverse associate a sentimenti positivi è addirittura minore rispetto a quello delle parole diverse associate a sentimenti negativi. Questo significa che le canzoni esprimono soprattutto sentimenti positivi però usando poche parole, ripetendole, mentre per esprimere sentimenti negativi si usa un vocabolario più vario, ecco quindi che il numero di parole diverse per esprimere sentimenti negativi è maggiore di quello delle parole diverse che esprimono sentimenti positivi.
Utilizzando il lexicon afinn si ottiene il valore di positività associato a ciascuna parola, quindi analizza la distribuzione nel corso degli anni del valore di positività delle parole nelle canzoni.
songWords<-songs_lyrics %>% group_by(word) %>% mutate(count=sum(count))
w<-songWords %>% group_by(year) %>% summarise(count=sum(count))
sentimentWords<-get_sentiments("afinn")
songWords<-songs_lyrics %>% left_join(sentimentWords)## Joining, by = "word"songSentiment<-songWords %>%group_by(track_id) %>% summarise(total_score=sum(score*count,na.rm = T))
# aggiungi colonna con punteggio sentimento al dataframe con tutte le canzoni che hanno il testo
songs_with_lyrics<-songs_with_lyrics %>% left_join(songSentiment)## Joining, by = "track_id"ggplot(songs_with_lyrics %>% filter(year>1970),aes(x=decade,y=total_score))+
geom_point()
ggplot(songs_with_lyrics%>% filter(year>1970) ,aes(x=factor(year),y=total_score))+
geom_boxplot()
Analisi dei tag associati alle canzoni
Analizza la distribuzione di tag associati alle canzoni nel corso del tempo
songs_tags<-dbGetQuery(dbCon,'select * from song_tag a join songs b on a.tid=b.track_id')
plotCountBy(songs_tags %>% filter(year!=0) %>% mutate(groupValue=year),"anno")
Il numero di tag per anno è molto correlato con il numero di canzoni per anno, visualizza quindi il numero di tag diviso il numero di canzoni per anno in modo da osservare quanti tag vengono associati solitamente ad una canzone con il variare del tempo.
songsByGroup<-songs_tags %>% filter(year>0) %>%
group_by(year) %>%
summarise(count = n(),songs=n_distinct(track_id),val=count/songs) %>%
collect()
ggplot(songsByGroup,aes(x=year,y=val))+
geom_col()
Quanti diversi tag ci sono?
songs_tags %>% distinct(tag) %>% nrow## [1] 33355Come è distribuito il numero di apparizioni dei tag? (cioè a quante canzoni è associato un tag)
# conta a quante canzoni è associato un tag
tag_count<-songs_tags %>% group_by(tag) %>% summarise(songs=n()) %>% arrange(desc(songs))
ggplot(tag_count,aes(x=songs))+
geom_histogram(binwidth = 0.1)+
scale_x_log10()+scale_y_log10()## Warning: Transformation introduced infinite values in continuous y-axis## Warning: Removed 4 rows containing missing values (geom_bar).
Tanti tag compaiono solo una volta (cioè sono associati a solo una canzone).
Visualizza tramite una word cloud i tag più frequenti, cioè associati a più canzoni.
wordcloud(tag_count$tag,tag_count$songs,max.words = 50)
Ogni canzone è associata a più tag, ciascuno con un certo grado di confidenza, quindi considerando anche il grado di confidenza si ha:
tag_count<-songs_tags %>% group_by(tag) %>% summarise(usage=sum(val)) %>% filter(usage>0) %>% arrange(desc(usage))
# come è distribuito il numero di apparizioni dei tag? (cioè a quante canzoni è associato un tag, secondo il grado di confidenza)
ggplot(tag_count,aes(x=usage))+
geom_histogram(binwidth = 0.1)+
scale_x_log10()+scale_y_log10()## Warning: Transformation introduced infinite values in continuous y-axis## Warning: Removed 5 rows containing missing values (geom_bar).
if(prepareData){
# aggiungi al dataframe delle canzoni il tag con maggiore confidenza per ciascuna canzone
songs_one_tag<-songs_tags %>% group_by(track_id) %>% summarise(first_tag=first(tag,order_by=desc(val)))
dbExecute(dbCon, "ALTER TABLE songs ADD COLUMN first_tag TEXT")
# inserisci i dati
dbExecute(dbCon, "UPDATE songs SET first_tag = :first_tag WHERE track_id = :track_id",songs_one_tag)
}
songs<-tbl(dbCon,"songs")La distribuzione è un po’ più spostata verso destra: non ci sono più tanti tag poco usati rispetto agli altri come prima. Visualizza word cloud.
wordcloud(tag_count$tag,tag_count$usage,max.words = 30)
Controlla l’andamento dell’uso dei tag nel corso del tempo. Considera i tag più usati tra i vari anni
# tag più usati nel corso del tempo, per ogni tag conta in quanti anni è stato usato
popular_tags_during_time<-songs_tags %>% group_by(tag) %>% summarise(years=n_distinct(year)) %>% arrange(desc(years))
popular_tags_during_time## # A tibble: 33,355 x 2
## tag years
## <chr> <int>
## 1 blues 58
## 2 american 54
## 3 classic rock 53
## 4 rock 52
## 5 soul 52
## 6 Love 51
## 7 pop 51
## 8 favorites 50
## 9 guitar 50
## 10 female vocalists 49
## # ... with 33,345 more rowsConsidera per ciascun anno i tag più usati
# conta le occorrenze di ciascun tag popolare nel corso del tempo
tag_count<-songs_tags %>% inner_join(popular_tags_during_time,by="tag") %>% group_by(tag,year) %>% summarise(count=n(),val=sum(val)) %>% arrange(desc(val))
# per ogni anno si prendono i primi tag più usati
popular_tags_val<-tag_count %>% group_by(year) %>% top_n(10,val)
popular_tags_val %>% distinct(tag) %>% nrow## [1] 717I primi 10 tag più usati ( top ten ) per ciascun anno sono diversi da anno in anno, in totale ci sono più di 700 tag diversi, quindi si considerano solo i 20 tag che appaiono più volte nelle top ten dei diversi anni.
# ci sono tanti tag diversi, quindi si considerano quelli che appaiono più volte tra i primi tag nel corso del tempo
tags<-popular_tags_val %>% group_by(tag) %>% summarise(count=n()) %>% arrange(desc(count)) %>% top_n(20)## Selecting by countmost_popular_tags<-popular_tags_val %>% filter(tag %in% tags$tag)
# raggruppa per anno in modo da poter poi calcolare il valore relativo rispetto all'anno
tagsByYear<-most_popular_tags %>%
filter(year!=0) %>%
group_by(year) %>%
summarise(val_year = sum(val))
tagsByYearTag<-most_popular_tags %>%
filter(year!=0) %>%
group_by(year,tag) %>%
summarise(val = sum(val))
# considera il valore relativo: quindi dividi il valore per la somma dei valori dello stesso anno
tagsByYearTag<-tagsByYearTag %>% inner_join(tagsByYear,by="year") %>% mutate(val=val/val_year)
ggplot(tagsByYearTag,aes(year,tag))+
geom_tile(aes(fill=val))+
scale_x_continuous(breaks = seq(1920,2010,5))+
theme(axis.text.x = element_text(angle = 45, hjust = 1))
Si può notare il pattern abbastanza scontato dei tag 60s, 70s, 80s, 90s che sono associati alle canzoni appartenenti allo stesso decennio, anche se ci sono delle canzoni del decennio 1970-1980 associate a 80s. Prima del 1960 le canzoni sono associate principalmente al tag blues (il tag più “vecchio”, cioè associato a canzoni con minor anno 1926) e in parte a country (tag apparso dopo il 1935).
Quali sono i tag maggiormente usati gli ultimi anni?
tagsByYearTag %>% filter(year>=2000&val>0) %>% group_by(tag) %>% summarise(s=n()) %>% arrange(-s)## # A tibble: 14 x 2
## tag s
## <chr> <int>
## 1 pop 11
## 2 rock 11
## 3 alternative 9
## 4 Hip-Hop 9
## 5 indie 9
## 6 alternative rock 8
## 7 female vocalists 8
## 8 electronic 6
## 9 punk 4
## 10 rap 4
## 11 soul 2
## 12 blues 1
## 13 hard rock 1
## 14 jazz 1In che anno è apparso e scomparso ciascun tag?
tagsByYearTag %>% group_by(tag) %>% summarise(start=min(year),end=max(year))## # A tibble: 23 x 3
## tag start end
## <chr> <dbl> <dbl>
## 1 60s 1960. 1969.
## 2 70s 1971. 1979.
## 3 80s 1978. 1990.
## 4 90s 1990. 1999.
## 5 alternative 1978. 2009.
## 6 alternative rock 1991. 2009.
## 7 blues 1926. 2005.
## 8 blues rock 1970. 1994.
## 9 classic rock 1963. 1990.
## 10 country 1936. 1998.
## # ... with 13 more rowsss<-songs_with_lyrics %>% filter(year>0 & first_tag %in% tags$tag) %>% group_by(first_tag,year) %>% summarise(count=n())
ggplot(ss,aes(x=year,y=count,fill=first_tag))+
geom_density(stat="identity")
Correlazione tra variabili considerando le nuove variabili aggiunte riguardo il testo
data_sub<-songs_with_lyrics %>% select(artist_familiarity,artist_hotttnesss,artist_latitude,artist_longitude,song_hotttnesss,duration,loudness,year,total_words,different_words,diversity,total_score) %>% collect()
pairs(data_sub)
pairs(data_sub %>% filter(year>0))
Osserva la distribuzione del numero di parole in una canzone a seconda del tag a cui è associata la canzone.
#quanti tag diversi ci sono
songs_with_lyrics %>% distinct(tag) %>% nrow## [1] 2350tags<-songs_with_lyrics %>% filter(!is.na(first_tag)) %>% group_by(first_tag) %>% summarise(count=n()) %>% arrange(-count) %>% top_n(5) %>% select(first_tag)## Selecting by countdata<-songs_with_lyrics %>% filter(first_tag %in% tags$first_tag)
ggplot(data,aes(x=total_words,fill=first_tag)) +
geom_histogram(position="identity",alpha=0.5)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
ggplot(data,aes(x=different_words,fill=first_tag)) +
geom_histogram(position="identity",alpha=0.5)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Le canzoni con il tag Hip-Hop sono quelle che solitamente sono composte da un grande numero di parole (più di 500), rispetto le canzoni associate agli altri tag, che sono più o meno formate dallo stesso numero di parole che è attorno a 250. Considerando il numero di parole diverse le canzoni con il tag Hip-Hop rimangono separate dalle altre infatti hanno un grande numero di parole diverse (più di 150), rispetto alle altre, che hanno un numero di parole diverse attorno a 75.
Quali sono i tag associati alle canzoni con il minor e maggior numero di parole? E per quali tag c’è una grande varietà nel numero di parole che compone la canzone? Per rispondere a queste domande raggruppa le canzoni secondo il loro tag, considera solo i tag che sono associati ad almeno 20 canzoni e calcola la media e la deviazione standard del numero totale di parole di cui è costituita ciascuna canzone.
library(DT)
data<-songs_with_lyrics %>% filter(!is.na(first_tag)) %>% group_by(first_tag) %>% summarise(m=mean(total_words),s=sd(total_words),songs=n(),ratio=s/m) %>%
filter(songs>20) # considera solo tag associati ad almeno un certo numero di canzoni (altrimenti la media e la deviazione standard sono poco significative)
datatable(data)Osserva la distribuzione del sentimento in una canzone a seconda del tag a cui è associata.
tags<-songs_with_lyrics %>% filter(!is.na(first_tag)) %>% group_by(first_tag) %>% summarise(count=n()) %>% arrange(-count) %>% top_n(5) %>% select(first_tag)## Selecting by countdata<-songs_with_lyrics %>% filter(first_tag %in% tags$first_tag)
ggplot(data,aes(x=total_score,fill=first_tag)) +
geom_histogram(position="identity",alpha=0.5)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
Le canzoni associate al tag Hip-Hop hanno un grado di negatività molto alto, al contrario le canzoni associate al tag pop hanno un grado di positività molto alto mentre le canzoni associate agli altri tag sono generalmente neutre e in parte sia positive che negative ma con valori più bassi.
Quali sono i tag associati alle canzoni con i più grandi valori di sentimento positivo o negativo? E per quali tag c’è una grande varietà nel sentimento? Per rispondere a queste domande raggruppa le canzoni secondo il loro tag, considera solo i tag che sono associati ad almeno 20 canzoni e calcola la media e la deviazione standard del valore del sentimento associato a ciascuna canzone.
data<-songs_with_lyrics %>% filter(!is.na(first_tag)) %>% group_by(first_tag) %>% summarise(m=mean(total_score),s=sd(total_score),songs=n(),ratio=s/m) %>%
filter(songs>20) # considera solo tag associati ad almeno un certo numero di canzoni (altrimenti la media e la deviazione standard sono poco significative)
datatable(data)Preferenze degli utenti
Fino a questo punto non si è tenuto conto delle preferenze degli utenti nei confronti delle canzoni. Per riuscire a comprendere meglio quale è l’impatto delle canzoni a seconda del sentimento che esprimono sulle persone, considera i dati relativi al dataset thisisjam.
# per eseguire le prossime query è meglio aggiungere alcuni indici al db
if(prepareData){
dbExecute(dbCon,"CREATE INDEX songs_track_id ON songs (track_id);")
dbExecute(dbCon,"CREATE INDEX jams_jam_id ON jams (jam_id);")
dbExecute(dbCon,"CREATE INDEX jam_msd_jam_id ON jam_msd (jam_id);")
dbExecute(dbCon,"CREATE INDEX jam_msd_track_id ON jam_msd (track_id);")
}
# numero di jams
jams<-dbGetQuery(dbCon,"select songs.track_id as track_id,count() as jams from songs
join jam_msd on jam_msd.track_id=songs.track_id
join jams on jams.jam_id= jam_msd.jam_id
group by songs.track_id")
songs_with_lyrics<-songs_with_lyrics %>% left_join(jams,by="track_id")
if(prepareData){
dbExecute(dbCon,"CREATE INDEX jams_user_id ON jams (user_id);")
dbExecute(dbCon,"CREATE INDEX likes_user_id ON likes (user_id);")
}
# numero di likes
jam_likes<-dbGetQuery(dbCon,"select songs.track_id as track_id,count() as likes from songs
join jam_msd on jam_msd.track_id=songs.track_id
join jams on jams.jam_id= jam_msd.jam_id
join likes on likes.user_id=jams.user_id
group by songs.track_id")
songs_with_lyrics<-songs_with_lyrics %>% left_join(jam_likes,by="track_id")data<-songs_with_lyrics %>% select(year,song_hotttnesss,jams,likes,total_score) %>% filter(year>0)
pairs(data)
Il numero di jam e like non sembra essere tanto correlato con l’anno e nemmeno con song_hottness; per quanto riguarda il sentimento della canzone risulta che la maggior parte di like e jam è attribuita a canzoni con un valore neutrale, inoltre allontanandosi da valori neutrali il numero di like diminusice. C’è una canzone con un alto grado di positività che ha anche numerosi like.
songs_with_lyrics %>% filter(!is.na(likes)) %>% top_n(1,total_score) %>% select(total_score,year,title,artist_name,likes)## # A tibble: 1 x 5
## total_score year title artist_name likes
## <int> <int> <chr> <chr> <int>
## 1 152 1983 (This Is Not A) Love Song (Live) Public Image L~ 32602Si tratta di “(This Is Not A) Love Song” (Letteralmente “Questa non è una canzone d’amore”), è un singolo del gruppo post-punk Public Image Ltd. La canzone irride le critiche dei fan e della stampa musicale mosse alla band accusata di star progressivamente “ammorbidendosi” per orientarsi verso sonorità maggiormente commerciali. Il titolo della canzone è ispirata a una strofa della canzone Her Story (1979) dei compagni di etichetta Virgin Flying Lizards, circa i gruppi che si “svendevano” per raggiungere il successo commerciale. Il motivo per il quale la canzone ha un alto grado di positività è dovuto al fatto che la parole “love” è molto ripetuta. Ecco qui le canzoni che ripetono più volte la parola “love”:
songs_lyrics %>% filter(word=="love") %>% arrange(-count) %>% inner_join(songs_with_lyrics,by="track_id") %>% select(title.x,year.x,artist_name.x, count,total_score) %>% top_n(5,count)## title.x year.x artist_name.x count
## 1 Don't Phunk With My Heart 0 Java 54
## 2 I'll Show You Love 1994 Usher 50
## 3 (This Is Not A) Love Song (Live) 1983 Public Image Ltd 47
## 4 Dangerously In Love Medley 0 Beyoncé 47
## 5 Luv In the First 0 Latif 42
## total_score
## 1 151
## 2 156
## 3 152
## 4 137
## 5 132La canzone “(This Is Not A) Love Song (Live)” è la terza. Nonostante la canzone neghi il fatto di essere una canzone d’amore, il punteggio riguardo al sentimento è positivo; questo perché, avendo a disposizione il testo della canzone in formato bag of words, non si riesce a riconoscere che la parola “love” è preceduta da una negazione.
Creazione dataset da zero
Per riuscire a comprendere meglio alcuni aspetti relativi al testo delle canzoni si è creato un dataset da zero, in modo da avere il testo completo delle canzoni e non in formato bag of words.
Avendo in un file tsv tutte le canzoni vincitrici del festival di sanremo dal 1962 al 2018 recuperate dall’ Articolo su Today si recupera i testi di ciascuna cazone utilizzando la Genius API. C’è anche un pacchetto per R geniusr che funge da interfaccia alla Web API di Genius.
# canzoni vincitrici di sanremo
sanremo<-read_tsv("data/sanremo.tsv",col_names = c("anno","cantanti","titolo"))## Parsed with column specification:
## cols(
## anno = col_integer(),
## cantanti = col_character(),
## titolo = col_character()
## )# recupera il testo contenuto nell'elemento html di classe lyrics contenuto nella risposta ottenuta richiedendo l'url indicatp
lyric_scraper <- function(url) {
read_html(url) %>%
html_node('.lyrics') %>%
html_text
}
# funzione per recuperare il testo della canzone
getSongLyrics<-function(url){
lyrics <- try(lyric_scraper(url))
if (class(lyrics) != 'try-error') {
# strip out non-lyric text and extra spaces
lyrics <- str_replace_all(lyrics, '\\[(Verse [[:digit:]]|Pre-Chorus [[:digit:]]|Hook [[:digit:]]|Chorus|Outro|Verse|Refrain|Hook|Bridge|Intro|Instrumental)\\]|[[:digit:]]|[\\.!?\\(\\)\\[\\],]', '')
lyrics <- str_replace_all(lyrics, '\\n', ' ')
lyrics <- str_replace_all(lyrics, '([A-Z])', ' \\1')
lyrics <- str_replace_all(lyrics, ' {2,}', ' ')
lyrics <- tolower(str_trim(lyrics))
} else {
lyrics <- lyrics
}
}
library(geniusr)
#genius_token(force = T) # per impostare il token per l'api genius
# salva in variabili ausiliarie i risultati dati dall'api genius
search<-list()
if(prepareData){
for(i in 1:nrow(sanremo)){
titolo<-sanremo[i,]$titolo
print(paste(i,titolo))
cantante<-sanremo[i,]$cantanti
songs<-search_song(search_term = titolo) # cerca le canzoni secondo il titolo
search[[titolo]]<-songs
song<-songs[1,] # solitamente la prima canzone è quella corretta, sarebbe meglio calcolare per ciascuna canzone nella lista ricevuta una sorta di punteggio di matching, ad esempio calcolando l'edit distance tra le stringhe che contengono il nome del cantante
songLyrics<-getSongLyrics(song$song_lyrics_url) # scarica il testo della canzone
sanremo[i,"lyrics"]<-songLyrics
}
# salva il risultato (le richieste all'api sono limitate)
write_tsv(sanremo,"data/sanremo_lyrics.tsv")
}Ci sono degli errori, alcune canzoni non hanno il testo corrispondente.
if(prepareData){
a<-data.frame(dist=numeric(),artist_name=character(),artist=character(),song_name=character(),song=character())
index<-1
for(i in names(search)){
a<-rbind(a,(search[[i]][1,c("artist_name","song_name")] %>% mutate(song=i,artist=sanremo$cantanti[index],dist=adist(sanremo$cantanti[index],search[[i]][1,"artist_name"]))))
index<-index+1
}
}Il problema è dovuto al fatto che si prendeva per ciascuna canzone il testo del primo risultato ottenuto dall’api di Genius e a volte il primo risultato non era quello desiderato. Ciò nonostante per alcune canzoni non ci sono proprio i testi sull’api di Genius, nemmeno nei risultati successivi al primo. Per questo motivo i testi delle canzoni non corretti sono stati scaricati dal sito Anglolo testi.
sanremo_lyrics<-read_tsv("data/sanremo_lyrics_adjusted.tsv")## Parsed with column specification:
## cols(
## anno = col_integer(),
## cantanti = col_character(),
## titolo = col_character(),
## lyrics = col_character(),
## sesso = col_double()
## )Scarica altre features delle canzoni utilizzando Spotify Web API. Per poter ottenere le feature delle canzoni occorre sapere il loro identificativo su spotify. Su spotify ci sono varie playlist che raccolgono più canzoni e si può ottenere l’identificativo di tutte le canzoni appartenenti alla playlist usando l’api, a patto di sapere l’identtificativo della playlist e dell’utente che l’ha creata. Cercando su google “sanremo all winners spotify” il primo risultato ottenuto è “https://open.spotify.com/user/1138907986/playlist/6H1azszUVaSFoV99Dqi2pI”: quindi assumendo che questo risultato si riferisce ad una playlist spotify con tutte le canzoni vincitrici di sanremo e che l’identificativo dell’utente è 1138907986 e l’identificativo della playlist è 6H1azszUVaSFoV99Dqi2pI, si procede ad interrogare il servizio api con questi input.
library(spotifyr)
# imposta client id e client secret per poter utilizzare le web api di spotify
Sys.setenv(SPOTIFY_CLIENT_ID = '')
Sys.setenv(SPOTIFY_CLIENT_SECRET = '')
if(prepareData){
access_token <- get_spotify_access_token() # recupera l'access token
playlists<-get_user_playlists("1138907986") # recupera le playlist dell'utente
playlistId<-"6H1azszUVaSFoV99Dqi2pI"
sanremoPlaylist<-playlists[playlists$playlist_uri==playlistId,] # estrai la playlist di sanremo
tracks<-get_playlist_tracks(sanremoPlaylist) # recupera gli identificativi delle canzoni della playlist di sanremo
# salva il risultato ottenuto (il numero di richieste all'api è limitato)
write_csv(tracks,"data/sanremo_tracks.csv")
}Avendo gli id delle canzoni recupera le features di ciascuna.
if(prepareData){
track_popularity <- get_track_popularity(tracks)
track_audio_features <- get_track_audio_features(tracks)
write_csv(track_popularity,"data/sanremo_tracks_popularity.csv")
write_csv(track_audio_features,"data/sanremo_track_audio_features.csv")
}Unisci insieme tutti i dati riguardo le feature delle canzoni ottenuti dall’api di spotify.
tracks<-read_csv("data/sanremo_tracks.csv")## Parsed with column specification:
## cols(
## playlist_name = col_character(),
## playlist_img = col_character(),
## track_name = col_character(),
## track_uri = col_character(),
## artist_name = col_character(),
## album_name = col_character(),
## album_img = col_character()
## )track_popularity<-read_csv("data/sanremo_tracks_popularity.csv")## Parsed with column specification:
## cols(
## track_uri = col_character(),
## track_popularity = col_integer()
## )track_audio_features<-read_csv("data/sanremo_track_audio_features.csv")## Parsed with column specification:
## cols(
## danceability = col_double(),
## energy = col_double(),
## key = col_character(),
## loudness = col_double(),
## mode = col_character(),
## speechiness = col_double(),
## acousticness = col_double(),
## instrumentalness = col_double(),
## liveness = col_double(),
## valence = col_double(),
## tempo = col_double(),
## track_uri = col_character(),
## duration_ms = col_double(),
## time_signature = col_integer(),
## key_mode = col_character()
## )sanremo_spotyfy_data<-tracks %>% inner_join(track_popularity,by="track_uri") %>% inner_join(track_audio_features,by="track_uri")
if(prepareData){
write_csv(sanremo_spotyfy_data,"data/sanremo_spotyfy_data.csv")
}Unisci i testi delle canzoni con i dati ottenuti da spotify.
spotifydata<-sanremo_spotyfy_data %>% mutate(titolo=track_name)
sanremo_lyrics %>% distinct(titolo) %>% nrow## [1] 67spotifydata %>% distinct(titolo) %>% nrow## [1] 67cdata<-sanremo_lyrics %>% inner_join(spotifydata,by="titolo")
nrow(cdata)## [1] 40I titoli hanno delle differenze, quindi per le canzoni rimanenti serve fare un matching minimizzando le differenze tra i titoli e i cantati. Si calcola l’edit distance tra le stringhe con il titolo delle canzoni e anche tra le stringhe con i cantanti delle canzoni. Si costruisce una matrice delle distanze data dalla somma delle due distanze. Si associano insieme i record che tra loro hanno la minima distanza.
library(DT)
remaining<-sanremo_lyrics %>% anti_join(cdata,by="titolo")
remaining_spotify<-spotifydata %>% anti_join(cdata,by="titolo")
dist_titolo<-adist(remaining$titolo,remaining_spotify$titolo)
dist_cantante<-adist(remaining$cantanti,remaining_spotify$artist_name)
dist<-dist_titolo+dist_cantante
data_min<-apply(dist,2,function(x)return(array(which.min(x))))
remaining_spotify$row_number<-1:nrow(remaining_spotify)
for(i in seq_along(data_min)){
index<-data_min[i]
remaining[index,"row_number"]<-i
}
remaining_combined<-remaining_spotify %>% inner_join(remaining,by="row_number")
remaining_combined<-remaining_combined %>% mutate(titolo=titolo.y) %>% select(-one_of(c("titolo.x","titolo.y","row_number")))
a<-remaining_combined %>% select(track_name,titolo)
## https://github.com/rstudio/DT/issues/447 problems of datatable with dark theme
datatable(a %>% select(titolo))Unendo tutto insieme
all_data<-cdata %>% rbind(remaining_combined)
nrow(all_data)## [1] 64Mancano ancora delle canzoni per le quali non ha funzionato il matching e quindi vengono sistemate “a mano”.
remaining<-sanremo_lyrics %>% anti_join(all_data)## Joining, by = c("anno", "cantanti", "titolo", "lyrics", "sesso")remaining_spotify<-spotifydata %>% anti_join(all_data)## Joining, by = c("playlist_name", "playlist_img", "track_name", "track_uri", "artist_name", "album_name", "album_img", "track_popularity", "danceability", "energy", "key", "loudness", "mode", "speechiness", "acousticness", "instrumentalness", "liveness", "valence", "tempo", "duration_ms", "time_signature", "key_mode", "titolo")## a mano, remaining e spotify data
print(spotifydata$track_name)## [1] "Grazie dei fiori"
## [2] "Vola colomba"
## [3] "Viale d'autunno"
## [4] "Viale d'autunno"
## [5] "Tutte le mamme"
## [6] "Tutte le mamme"
## [7] "Buongiorno tristezza"
## [8] "Buongiorno tristezza"
## [9] "Aprite le finestre"
## [10] "Corde della mia chitarra"
## [11] "Corde della mia chitarra"
## [12] "Nel blu dipinto di blu - Volare"
## [13] "Nel blu dipinto di blu - Volare"
## [14] "Piove"
## [15] "Piove"
## [16] "Romantica"
## [17] "Romantica"
## [18] "Al di là"
## [19] "Al di là"
## [20] "Addio... addio"
## [21] "Addio...addio"
## [22] "Uno per tutte"
## [23] "Uno Per Tutte"
## [24] "Non ho l'età"
## [25] "Non ho l'età"
## [26] "Se Piangi Se Ridi"
## [27] "Dio Come Ti Amo"
## [28] "Dio, Come Ti Amo"
## [29] "Non pensare a me"
## [30] "Non pensare a me"
## [31] "Canzone Per Te - Versão Remasterizada"
## [32] "Zingara"
## [33] "Zingara"
## [34] "Chi Non Lavora Non Fa L'Amore - Remastered"
## [35] "Il cuore è uno zingaro"
## [36] "Il Cuore E' Uno Zingaro (El Corazon Es Un Gitano)"
## [37] "I Giorni Del Arcobaleno (Los Dias Del Arcoiris)"
## [38] "Un Grande Amore E Niente Più"
## [39] "Ciao cara come stai"
## [40] "Bella da morire"
## [41] "E dirsi ciao - 2011 - Remaster;"
## [42] "Amare"
## [43] "Solo noi"
## [44] "Per Elisa"
## [45] "Storie di tutti i giorni"
## [46] "Sarà quel che sarà"
## [47] "Ci sarà"
## [48] "Se m'innamoro"
## [49] "Adesso tu"
## [50] "Si può dare di più"
## [51] "Perdere L'amore"
## [52] "Ti lascerò"
## [53] "Uomini soli"
## [54] "Se stiamo insieme"
## [55] "Portami a ballare"
## [56] "Mistero"
## [57] "Passerà"
## [58] "Come saprei"
## [59] "La terra dei cachi"
## [60] "Fiumi Di Parole"
## [61] "Senza Te o con Te - Sanremo 1998"
## [62] "Senza pietà"
## [63] "Sentimento"
## [64] "Luce (Tramonti a Nord Est)"
## [65] "Messaggio D'Amore"
## [66] "L'Uomo Volante"
## [67] "Angelo"
## [68] "Vorrei Avere Il Becco"
## [69] "Ti Regalero' Una Rosa"
## [70] "La forza mia"
## [71] "Per Tutte Le Volte Che..."
## [72] "Chiamami Ancora Amore"
## [73] "Non E' L'Inferno"
## [74] "L'essenziale"
## [75] "Controvento"
## [76] "Grande amore"
## [77] "Un Giorno Mi Dirai"
## [78] "Occidentali's Karma - Radio Edit"remaining$row_number<-c(14,24,26,31,34,NA,NA,NA,NA,NA)
spotifydata$row_number<-1:nrow(spotifydata)
remaining_combined<-remaining %>% inner_join(spotifydata,by="row_number")
remaining_combined<-remaining_combined %>% mutate(titolo=titolo.y) %>% select(-one_of(c("titolo.x","titolo.y","row_number")))
all_data<- all_data %>% rbind(remaining_combined)Ci sono delle canzoni di cui non si hanno le features da spotify
# anni mancanti
sanremo_years<-min(sanremo$anno):max(sanremo$anno)
missing_years<-setdiff(sanremo_years,all_data$anno)
sanremo$titolo[sanremo$anno%in%missing_years]## [1] "Ragazza del Sud" "Non lo faccio più"
## [3] "Vorrei incontrarti fra centanni" "Luce (Tramonti a nord est)"
## [5] "Colpo di fulmine" "Non mi avete fatto niente"# aggiungi le canzoni che non hanno audio features
all_data<-all_data %>% rbind(remaining_combined)
# controlla corrispondenza titoli
View(all_data %>% select(titolo,track_name))
# ci sono titoli doppi, rimuovi i doppioni
all_data %>% distinct(titolo) %>% nrow## [1] 62all_data<-all_data %>% group_by(titolo) %>% top_n(1) %>% ungroup()## Selecting by key_modenrow(all_data)## [1] 69all_data %>% distinct(titolo) %>% nrow## [1] 62# al massimo un record per titolo
write_tsv(all_data %>% group_by(titolo) %>% filter(row_number()==1),"data/sanremo_dataset.tsv")Analisi del testo sul dataset sanremo
Analizza il numero di parole usato in ciascuna canzone nel corso degli anni
library(tidytext)
library(tm)## Loading required package: NLP##
## Attaching package: 'NLP'## The following object is masked from 'package:ggplot2':
##
## annotate# per evitare problemi elimina gli accenti o strani caratteri dal testo delle canzoni
all_data$lyrics<-iconv(all_data$lyrics,from="UTF-8",to="ASCII//TRANSLIT")
# sostituire il carattere ' con spazio
library(stringr)##
## Attaching package: 'stringr'## The following object is masked _by_ '.GlobalEnv':
##
## wordsall_data$lyrics<-str_replace_all(all_data$lyrics,"'"," ")
# spezza il testo in singole parole
song_tokens<-all_data %>% mutate(lyrics=removePunctuation(lyrics)) %>% unnest_tokens(word, lyrics) %>% ungroup()
# considera come gruppo l'anno
# per ogni anno quante parole totali sono apparse e quante parole diverse sono state usate
songs_words<-song_tokens %>% group_by(anno,word) %>% summarise(count=n())
songs_words_count<-getWordsCount(songs_words %>% mutate(songId=anno)) %>% arrange(total_words)
plotWordsCount<-function(songs_words_count){
data<-songs_words_count %>% gather(measure,value,-songId)
data %>% filter(measure!="diversity") %>%
ggplot(aes(x=songId,y=value,color=measure,group=measure))+
geom_point()+geom_smooth(method = "lm")
}
plotWordsCount(songs_words_count)
Quanto sono lunghe (in termini di caratteri) le parole usate nelle canzoni?
# lunghezza parole
words_length<-song_tokens %>% mutate(len=nchar(word))
ggplot(words_length,aes(x=len)) +
geom_bar()
# per ogni anno quante volte è apparsa ciascuna parola
songs_words<-song_tokens %>% group_by(anno,word) %>% summarise(count=n())
words_length_stat<-words_length %>% group_by(anno) %>% summarise(m=mean(len),s=sd(len))%>%inner_join(all_data %>% select(titolo,anno))## Joining, by = "anno"ggplot(words_length_stat,aes(x=factor(anno),y=m,ymin=m-3*s,ymax=m+3*s))+
geom_pointrange()+
theme(axis.text.x = element_text(angle = 60, vjust = 1, hjust=1))
calcola numero parole totali, diverse e rapporto diverse/totali
songs_words_count<-getWordsCount(songs_words %>% mutate(songId=anno)) %>% arrange(total_words)
plotWordsCount(songs_words_count)
# considera come gruppo la canzone
songs_words<-song_tokens %>% group_by(titolo,word) %>% summarise(count=n())
songs_words_count<-getWordsCount(songs_words %>% mutate(songId=titolo)) %>% arrange(total_words)
songs<-all_data %>% inner_join(songs_words_count, by=c("titolo"="songId")) %>% unite(songId,anno,titolo,sep="-") %>% select(songId,cantanti,total_words,different_words,diversity)
datatable(songs)Come sopra ma eliminando le stop words
# rimuovi stop words
stop_words_ita<-data.frame(word=stopwords("it"))
song_tokens<-song_tokens %>% anti_join(stop_words_ita)## Joining, by = "word"## Warning: Column `word` joining character vector and factor, coercing into
## character vector# considera come gruppo l'anno
# per ogni anno quante volte è apparsa ciascuna parola
songs_words<-song_tokens %>% group_by(anno,word) %>% summarise(count=n())
plotCountBy(songs_words %>% mutate(groupValue=anno),"song")
# calcola numero parole totali, diverse e rapporto diverse/totali
songs_words_count<-getWordsCount(songs_words %>% mutate(songId=anno)) %>% arrange(total_words)
plotWordsCount(songs_words_count)
# considera come gruppo la canzone
songs_words<-song_tokens %>% group_by(titolo,word) %>% summarise(count=n())
songs_words_count<-getWordsCount(songs_words %>% mutate(songId=titolo)) %>% arrange(total_words)
songs<-all_data %>% inner_join(songs_words_count, by=c("titolo"="songId")) %>% unite(songId,anno,titolo,sep="-") %>% select(songId,cantanti,total_words,different_words,diversity)Considera uso delle parole
# quante volte è stata usata ciascuna parola e in quante canzoni
words<-song_tokens %>% group_by(word) %>% summarise(count=n(),songs=length(unique(titolo))) %>% arrange(desc(count))
# word cloud
library(wordcloud)
# in base a quante volte è stata usata una parola
wordcloud(words$word,words$count,max.words = 50)
# in base a quante canzoni hanno usato una parola
wordcloud(words$word,words$songs,max.words = 50)
Considera uso delle parole applicando lo stemming
library(SnowballC)
print(getStemLanguages())## [1] "danish" "dutch" "english" "finnish" "french"
## [6] "german" "hungarian" "italian" "norwegian" "porter"
## [11] "portuguese" "romanian" "russian" "spanish" "swedish"
## [16] "turkish"# quante volte è stata usata ciascuna parola e in quante canzoni
words<-song_tokens %>% ungroup %>% mutate(word=wordStem(word,language="italian"))%>% group_by(word) %>% summarise(count=n(),songs=length(unique(titolo))) %>% arrange(desc(count))
# word cloud
wordcloud(words$word,words$count,max.words = 50)
Considera tf-idf delle parole
words<-songs_words %>% bind_tf_idf(word, titolo, count)
wordcloud(words$word,words$tf_idf,max.words = 30)
Analisi sulle co-occorrenze delle parole
lyrics<-all_data$lyrics %>% tolower
ds <- Corpus(VectorSource(lyrics))
binDTM <- DocumentTermMatrix(ds, control=list(bounds = list(global=c(1, Inf)), weighting = weightBin))
require(Matrix)## Loading required package: Matrix##
## Attaching package: 'Matrix'## The following object is masked from 'package:tidyr':
##
## expandbinDTM <- sparseMatrix(i = binDTM$i, j = binDTM$j, x = binDTM$v, dims = c(binDTM$nrow, binDTM$ncol), dimnames = dimnames(binDTM))
###https://tm4ss.github.io/docs/Tutorial_5_Co-occurrence.html#2_counting_co-occurrences
# Matrix multiplication for cooccurrence counts
coocCounts <- t(binDTM) %*% binDTM
cc<-as.matrix(coocCounts)Trova co occorrenze più frequenti
diag(cc)<-0# sulla diagonale si ha il nuero di volte che è comparsa una certa parola
freq<-sort(cc,decreasing = TRUE)
sapply(freq[1:20],function(x){which(cc==x,arr.ind=TRUE) %>% rownames})## [[1]]
## [1] "non" "che"
##
## [[2]]
## [1] "non" "che"
##
## [[3]]
## [1] "piu" "che"
##
## [[4]]
## [1] "piu" "che"
##
## [[5]]
## [1] "non" "piu"
##
## [[6]]
## [1] "non" "piu"
##
## [[7]]
## [1] "per" "che" "non" "per"
##
## [[8]]
## [1] "per" "che" "non" "per"
##
## [[9]]
## [1] "per" "che" "non" "per"
##
## [[10]]
## [1] "per" "che" "non" "per"
##
## [[11]]
## [1] "che" "non" "amore" "amore"
##
## [[12]]
## [1] "che" "non" "amore" "amore"
##
## [[13]]
## [1] "che" "non" "amore" "amore"
##
## [[14]]
## [1] "che" "non" "amore" "amore"
##
## [[15]]
## [1] "con" "che" "non" "piu" "per" "con"
##
## [[16]]
## [1] "con" "che" "non" "piu" "per" "con"
##
## [[17]]
## [1] "con" "che" "non" "piu" "per" "con"
##
## [[18]]
## [1] "con" "che" "non" "piu" "per" "con"
##
## [[19]]
## [1] "con" "che" "non" "piu" "per" "con"
##
## [[20]]
## [1] "con" "che" "non" "piu" "per" "con"# quante volte è stata usata ciascuna parola e in quante canzoni
words<-song_tokens %>% group_by(word) %>% summarise(count=n(),songs=length(unique(titolo))) %>% arrange(desc(count)) %>% filter(count>10)
# elimina parole poco usate
ic<-which(colnames(cc)%in%words$word)
cc_s<-cc[ic,ic]
freq<-order(cc_s,decreasing = TRUE)
words<-colnames(cc_s)
#co_occ<-lapply(freq[1:50],function(x){return(c(words[floor(x/nrow(cc_s))],words[x%%nrow(cc_s)]))})
co_occ<-sapply(freq[1:50],function(x){return(paste(words[floor(x/nrow(cc_s))],words[x%%nrow(cc_s)],sep="-"))})
d<-data.frame(a=co_occ) %>% separate(a,sep = "-",into=c("a","b"))
l<-(d %>% group_by(a) %>% summarise(count=n())) %>% rename(w=a)
r<-(d %>% group_by(b) %>% summarise(count=n())) %>% rename(w=b)
co_occ<-l %>% rbind( r) %>% arrange(desc(count))calculateCoocStatistics<-function(coocTerm,binDTM,measure){
k <- nrow(binDTM)
ki <- sum(binDTM[, coocTerm])
kj <- colSums(binDTM)
names(kj) <- colnames(binDTM)
kij <- coocCounts[coocTerm, ]
if(measure=="mutual"){
########## MI: log(k*kij / (ki * kj) ########
mutualInformationSig <- log(k * kij / (ki * kj))
mutualInformationSig <- mutualInformationSig[order(mutualInformationSig, decreasing = TRUE)]
return(mutualInformationSig)
}else if (measure=="dice"){
########## DICE: 2 X&Y / X + Y ##############
dicesig <- 2 * kij / (ki + kj)
dicesig <- dicesig[order(dicesig, decreasing=TRUE)]
return(dicesig)
}else{
########## Log Likelihood ###################
logsig <- 2 * ((k * log(k)) - (ki * log(ki)) - (kj * log(kj)) + (kij * log(kij))
+ (k - ki - kj + kij) * log(k - ki - kj + kij)
+ (ki - kij) * log(ki - kij) + (kj - kij) * log(kj - kij)
- (k - ki) * log(k - ki) - (k - kj) * log(k - kj))
logsig <- logsig[order(logsig, decreasing=T)]
return(logsig)
}
}term<-"sogno"
mutualInformationSig<-calculateCoocStatistics(term,binDTM,"mutual")
dicesig<-calculateCoocStatistics(term,binDTM,"dice")
logsig<-calculateCoocStatistics(term,binDTM,"mutual")
kij <- coocCounts[term, ]
# Put all significance statistics in one Data-Frame
resultOverView <- data.frame(
names(sort(kij, decreasing=T)[1:10]), sort(kij, decreasing=T)[1:10],
names(mutualInformationSig[1:10]), mutualInformationSig[1:10],
names(dicesig[1:10]), dicesig[1:10],
names(logsig[1:10]), logsig[1:10],
row.names = NULL)
colnames(resultOverView) <- c("Freq-terms", "Freq", "MI-terms", "MI", "Dice-Terms", "Dice", "LL-Terms", "LL")
print(resultOverView)## Freq-terms Freq MI-terms MI Dice-Terms Dice LL-Terms
## 1 sogno 12 annunciar 1.7492 sogno 1.0000000 annunciar
## 2 per 11 appuntamento 1.7492 com 0.4705882 appuntamento
## 3 non 10 aprite 1.7492 questa 0.4666667 aprite
## 4 che 9 bel 1.7492 cose 0.4545455 bel
## 5 chi 8 comincia 1.7492 mano 0.4545455 comincia
## 6 piu 8 cominciato 1.7492 morire 0.4444444 cominciato
## 7 come 8 davanzale 1.7492 chi 0.4210526 davanzale
## 8 questo 7 dolcemente 1.7492 questo 0.4000000 dolcemente
## 9 questa 7 festa 1.7492 festa 0.4000000 festa
## 10 vita 7 finestre 1.7492 poco 0.4000000 finestre
## LL
## 1 1.7492
## 2 1.7492
## 3 1.7492
## 4 1.7492
## 5 1.7492
## 6 1.7492
## 7 1.7492
## 8 1.7492
## 9 1.7492
## 10 1.7492coocTerm<-"amore"
coocs <- calculateCoocStatistics(term, binDTM, measure="LOGLIK")
numberOfCoocs<-10
numberOfCoocs2<-5
resultGraph <- data.frame(from = character(), to = character(), sig = numeric(0))
# The structure of the temporary graph object is equal to that of the resultGraph
tmpGraph <- data.frame(from = character(), to = character(), sig = numeric(0))
# Fill the data.frame to produce the correct number of lines
tmpGraph[1:numberOfCoocs, 3] <- coocs[1:numberOfCoocs]
# Entry of the search word into the first column in all lines
tmpGraph[, 1] <- coocTerm
# Entry of the co-occurrences into the second column of the respective line
tmpGraph[, 2] <- names(coocs)[1:numberOfCoocs]
# Set the significances
tmpGraph[, 3] <- coocs[1:numberOfCoocs]
# Attach the triples to resultGraph
resultGraph <- rbind(resultGraph, tmpGraph)
# Iteration over the most significant numberOfCoocs co-occurrences of the search term
for (i in 1:numberOfCoocs){
# Calling up the co-occurrence calculation for term i from the search words co-occurrences
newCoocTerm <- names(coocs)[i]
coocs2 <- calculateCoocStatistics(newCoocTerm, binDTM, measure="LOGLIK")
# Structure of the temporary graph object
tmpGraph <- data.frame(from = character(), to = character(), sig = numeric(0))
tmpGraph[1:numberOfCoocs2, 3] <- coocs2[1:numberOfCoocs2]
tmpGraph[, 1] <- newCoocTerm
tmpGraph[, 2] <- names(coocs2)[1:numberOfCoocs2]
tmpGraph[, 3] <- coocs2[1:numberOfCoocs2]
#Append the result to the result graph
resultGraph <- rbind(resultGraph, tmpGraph[2:length(tmpGraph[, 1]), ])
}library(igraph)##
## Attaching package: 'igraph'## The following object is masked from 'package:tidyr':
##
## crossing## The following objects are masked from 'package:dplyr':
##
## as_data_frame, groups, union## The following objects are masked from 'package:stats':
##
## decompose, spectrum## The following object is masked from 'package:base':
##
## unionlibrary(ggraph)
graphNetwork <- graph_from_data_frame(resultGraph)
# rimuovi i nodi che hanno meno di due collegamenti
#graphNetwork <- delete.vertices(graphNetwork, V(graphNetwork)[degree(graphNetwork) < 2])
# indica se il nodo corrisponde alla parola centrale
V(graphNetwork)$search <- V(graphNetwork)$name == coocTerm
# dimensione del nodo in base al numero di canzoni in cui si usa la parola corrispondente
words<-song_tokens %>% group_by(word) %>% summarise(count=n(),songs=length(unique(titolo))) %>% arrange(desc(count))
size<-words %>% filter(word %in% V(graphNetwork)$name)
size<-size[order(match(size$word,V(graphNetwork)$name)),"songs"] %>% unlist
V(graphNetwork)$size <- size## Warning in vattrs[[name]][index] <- value: il numero di elementi da
## sostituire non è un multiplo della lunghezza di sostituzioneggraph(graphNetwork,layout="kk")+
geom_edge_link(aes(alpha=sig, width=sig))+
geom_node_point(aes(color=search,size=size))+
geom_node_text(aes(label=name))
Considera n-grams
# estrai bigrammi e trigrammi
bigrams<-all_data %>% mutate(lyrics=removePunctuation(lyrics)) %>% unnest_tokens(word, lyrics,token="ngrams",n=2) %>% ungroup()
trigrams<-all_data %>% mutate(lyrics=removePunctuation(lyrics)) %>% unnest_tokens(word, lyrics,token="ngrams",n=3) %>% ungroup()
quagrams<-all_data %>% mutate(lyrics=removePunctuation(lyrics)) %>% unnest_tokens(word, lyrics,token="ngrams",n=4) %>% ungroup()
cigrams<-all_data %>% mutate(lyrics=removePunctuation(lyrics)) %>% unnest_tokens(word, lyrics,token="ngrams",n=5) %>% ungroup()
ngrams<-bigrams %>% mutate(n=2)%>% rbind(trigrams %>% mutate(n=3)) %>% rbind(quagrams %>% mutate(n=4)) %>% rbind(cigrams %>% mutate(n=5))
# conta quante volte è usato ciascun ngram ed in quante canzoni
words<-ngrams %>% group_by(word) %>% summarise(count=n(),songs=length(unique(titolo))) %>% arrange(desc(count))
words## # A tibble: 35,166 x 3
## word count songs
## <chr> <int> <int>
## 1 solo noi 50 1
## 2 che non 45 24
## 3 il mio 41 14
## 4 c e 39 21
## 5 l amore 38 15
## 6 noi solo 36 1
## 7 noi solo noi 36 1
## 8 non e 32 14
## 9 con te 28 10
## 10 a te 26 9
## # ... with 35,156 more rows# elimina ngrams che contengono 2 o più stopwords
# conta quante stopwords sono contenute in ciascun ngram
bigrams$stopwords<-sapply(bigrams$word,function(word){sum(str_split(word,pattern = " ") %>% unlist%in% stop_words_ita$word)})
trigrams$stopwords<-sapply(trigrams$word,function(word){sum(str_split(word,pattern = " ") %>% unlist%in% stop_words_ita$word)})
quagrams$stopwords<-sapply(quagrams$word,function(word){sum(str_split(word,pattern = " ") %>% unlist%in% stop_words_ita$word)})
cigrams$stopwords<-sapply(cigrams$word,function(word){sum(str_split(word,pattern = " ") %>% unlist%in% stop_words_ita$word)})
# unisci tutto insieme, vanno mantenuti i duplicati quindi usa rbind e non union
ngrams<-bigrams %>% mutate(n=2)%>% rbind(trigrams %>% mutate(n=3)) %>% rbind(quagrams %>% mutate(n=4)) %>% rbind(cigrams %>% mutate(n=5))
# elimina ngrams con più di 1 stopwords
ngrams<-ngrams %>% filter(stopwords<2)
words<-ngrams %>% group_by(word) %>% summarise(count=n(),songs=length(unique(titolo))) %>% arrange(desc(count))
words## # A tibble: 16,208 x 3
## word count songs
## <chr> <int> <int>
## 1 solo noi 50 1
## 2 l amore 38 15
## 3 noi solo 36 1
## 4 con te 28 10
## 5 a te 26 9
## 6 solo noi solo 26 1
## 7 un giorno 22 10
## 8 cos e 21 6
## 9 una rosa 21 1
## 10 di me 20 14
## # ... with 16,198 more rows# considera ngram usati in almeno due canzoni
freq_ngrams<-words %>% filter(songs>1)
# in che canzoni sono usati gli ngram più frequenti
song_ngrams<-freq_ngrams %>% merge(all_data) %>% mutate(match=str_detect(lyrics,word)) %>% filter(match)
#all_data %>% filter(str_detect(lyrics,paste(freq_ngrams$word,collapse="|"))) %>% select(titolo)
# word cloud
wordcloud(words$word,words$count,max.words = 50)## Warning in wordcloud(words$word, words$count, max.words = 50): una rosa
## could not be fit on page. It will not be plotted.## Warning in wordcloud(words$word, words$count, max.words = 50): ancora amore
## chiamami could not be fit on page. It will not be plotted.
# elimina ngrams con pochi caratteri
freq_ngrams<-freq_ngrams %>% filter(nchar(word)>5)
song_ngrams<-freq_ngrams %>% merge(all_data) %>% mutate(match=str_detect(lyrics,word)) %>% filter(match)
wordcloud(words$word,words$count,max.words = 50)
POS tagging
library(NLP)
library(openNLP)
library(purrr)##
## Attaching package: 'purrr'## The following objects are masked from 'package:igraph':
##
## compose, simplify## The following object is masked from 'package:maps':
##
## map# scarica modello per lingua italiana
#install.packages("openNLPmodels.it",
# repos = "http://datacube.wu.ac.at/",
# type = "source")
library(openNLPmodels.it)
word_ann <- Maxent_Word_Token_Annotator(language="it")
sent_ann <- Maxent_Sent_Token_Annotator(language="it")
annotated_data<-all_data %>% mutate(annotations=map(lyrics,function(x){
annotations<- annotate(x, list(sent_ann, word_ann))
return(annotations)
}))
#<- annotate(all_data$lyrics, list(sent_ann, word_ann))
annotated_data<-annotated_data %>% mutate(annotated_lyrics=map2(lyrics,annotations,function(lyrics,annotations){
annotated_lyrics<-AnnotatedPlainTextDocument(lyrics, annotations)
return(annotated_lyrics)
}))
annotated_lyrics<-AnnotatedPlainTextDocument(annotated_data$lyrics, annotated_data$annotations)data<-annotated_data %>% mutate(sentences=map(annotated_lyrics,function(annotated_lyrics){
s<-sents(annotated_lyrics)
return(s)
}), words=map(annotated_lyrics,function(annotated_lyrics){
s<-words(annotated_lyrics)
return(s)
}))
# statistiche su lunghezza frasi e parole
# considerando tutte le canzoni insieme
# lunghezza frasi (in base al numero delle parole)
sentences_length<-sapply(data$sentences,function(x){return(length(x))})
summary(sentences_length)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 1.000 1.000 3.681 3.000 40.000# alcune frasi sono molto lunghe, sintomo di qualche problema# lunghezza parole (in base al numero di caratteri)
words_length<-sapply(words,function(x){return(nchar(x))})
summary(words_length)## word count songs
## Min. : 3.00 Min. :1.000 Min. :1
## 1st Qu.:11.00 1st Qu.:1.000 1st Qu.:1
## Median :15.00 Median :1.000 Median :1
## Mean :16.23 Mean :1.004 Mean :1
## 3rd Qu.:21.00 3rd Qu.:1.000 3rd Qu.:1
## Max. :57.00 Max. :2.000 Max. :2# per ciascuna canzone (per fare un check)
words_length<-sapply(data$words,function(x){return(nchar(x))})
words_length %>% map(summary)## [[1]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 4.000 4.087 6.000 12.000
##
## [[2]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 3.973 6.000 13.000
##
## [[3]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 4.000 3.883 5.000 12.000
##
## [[4]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 5.000 4.581 6.000 10.000
##
## [[5]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 5.000 4.581 6.000 10.000
##
## [[6]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 4.000 4.535 6.000 12.000
##
## [[7]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 3.000 5.000 4.564 6.000 12.000
##
## [[8]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 3.000 5.000 4.564 6.000 12.000
##
## [[9]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 3.673 6.000 11.000
##
## [[10]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 2.000 2.618 3.000 9.000
##
## [[11]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.00 2.00 3.00 3.89 5.00 12.00
##
## [[12]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 3.442 5.000 10.000
##
## [[13]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.00 2.00 3.50 3.88 5.00 12.00
##
## [[14]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 3.844 6.000 11.000
##
## [[15]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 3.834 5.000 10.000
##
## [[16]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 4.000 4.041 6.000 11.000
##
## [[17]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 3.045 4.000 14.000
##
## [[18]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 3.905 5.250 11.000
##
## [[19]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 4.000 4.046 6.000 11.000
##
## [[20]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 3.743 5.000 12.000
##
## [[21]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 4.000 3.851 5.000 10.000
##
## [[22]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 3.848 5.000 9.000
##
## [[23]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 3.569 5.000 9.000
##
## [[24]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 4.000 4.481 7.000 12.000
##
## [[25]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 3.865 5.000 12.000
##
## [[26]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 4.000 4.425 6.000 12.000
##
## [[27]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 4.000 4.259 6.000 10.000
##
## [[28]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 3.689 6.000 10.000
##
## [[29]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 3.961 6.000 10.000
##
## [[30]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.250 4.000 4.318 6.000 11.000
##
## [[31]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 4.000 4.406 6.000 11.000
##
## [[32]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.00 2.00 3.00 3.91 5.00 13.00
##
## [[33]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 3.458 5.000 9.000
##
## [[34]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.500 4.032 5.000 12.000
##
## [[35]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 4.216 6.000 13.000
##
## [[36]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 3.909 5.000 11.000
##
## [[37]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 3.786 5.000 11.000
##
## [[38]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.00 3.00 4.00 4.48 6.00 10.00
##
## [[39]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.00 3.00 3.00 3.94 5.00 10.00
##
## [[40]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 4.000 4.311 6.000 10.000
##
## [[41]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 4.013 6.000 12.000
##
## [[42]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 3.000 4.000 3.855 5.000 11.000
##
## [[43]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 3.864 5.000 11.000
##
## [[44]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 3.534 5.000 9.000
##
## [[45]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 4.000 4.201 6.000 12.000
##
## [[46]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 3.582 5.000 10.000
##
## [[47]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 3.974 5.000 10.000
##
## [[48]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 3.724 5.000 12.000
##
## [[49]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 3.957 5.000 10.000
##
## [[50]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 4.274 6.000 11.000
##
## [[51]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.500 3.994 5.000 13.000
##
## [[52]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 3.000 4.000 4.475 6.000 12.000
##
## [[53]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 4.000 4.044 5.000 15.000
##
## [[54]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 3.000 5.000 4.666 6.000 11.000
##
## [[55]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 4.129 6.000 11.000
##
## [[56]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 4.000 4.263 6.000 12.000
##
## [[57]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 4.000 3.917 5.000 10.000
##
## [[58]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 3.728 5.000 11.000
##
## [[59]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.00 2.00 5.00 4.64 6.00 14.00
##
## [[60]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 3.000 4.000 3.832 5.000 7.000
##
## [[61]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 3.504 5.000 10.000
##
## [[62]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 3.817 5.000 8.000
##
## [[63]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 3.694 5.000 10.000
##
## [[64]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 3.349 5.000 10.000
##
## [[65]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 3.000 4.000 3.832 5.000 7.000
##
## [[66]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 3.504 5.000 10.000
##
## [[67]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 3.817 5.000 8.000
##
## [[68]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 3.694 5.000 10.000
##
## [[69]]
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.000 2.000 3.000 3.349 5.000 10.000# ora controlla le frasi
data_sents<- data %>% unnest(sentences,.preserve=words)
# quante frasi ha ciascuna canzone
data_sents %>% group_by(titolo) %>% summarise(n_sentences=n()) %>% group_by(n_sentences) %>% summarise(songs=n())## # A tibble: 13 x 2
## n_sentences songs
## <int> <int>
## 1 1 34
## 2 2 11
## 3 3 2
## 4 4 1
## 5 5 1
## 6 6 4
## 7 7 2
## 8 9 2
## 9 10 1
## 10 11 1
## 11 32 1
## 12 34 1
## 13 40 1# molte canzoni hanno solo poche frasi, c'è qualche problema con la divisione in frasi (dovuto al fatto che varie canzoni non hanno alcuna punteggiatura nel testo)pos_ann<-Maxent_POS_Tag_Annotator(language="it")
pos_tags<-read_tsv("data/pos_tags.tsv",col_names = c("pos","detail","meaning"))## Parsed with column specification:
## cols(
## pos = col_character(),
## detail = col_character(),
## meaning = col_character()
## )## Warning in rbind(names(probs), probs_f): number of columns of result is not
## a multiple of vector length (arg 1)## Warning: 33 parsing failures.
## row # A tibble: 5 x 5 col row col expected actual file expected <int> <chr> <chr> <chr> <chr> actual 1 1 <NA> 3 columns 2 columns 'data/pos_tags.tsv' file 2 2 <NA> 3 columns 2 columns 'data/pos_tags.tsv' row 3 3 <NA> 3 columns 2 columns 'data/pos_tags.tsv' col 4 4 <NA> 3 columns 2 columns 'data/pos_tags.tsv' expected 5 5 <NA> 3 columns 2 columns 'data/pos_tags.tsv'
## ... ................. ... ..................................................... ........ ..................................................... ...... ..................................................... .... ..................................................... ... ..................................................... ... ..................................................... ........ .....................................................
## See problems(...) for more details.# per alcune righe non c'è il detail ed il valore del meaning è messo al suo posto
pos_tags$meaning[is.na(pos_tags$meaning)]<-pos_tags$detail[is.na(pos_tags$meaning)]
# converti in minuscolo il pos tag
pos_tags<-pos_tags %>% mutate(pos=tolower(pos))
data<-data %>% mutate(lyrics=removePunctuation(lyrics))%>% mutate(pos_annotation=map2(lyrics,annotations,function(x,y){ # pos annotations
pos_annotations<-NLP::annotate(x, pos_ann,y) # usa il namespace per evitare problemi di ambiguità
pos_words <- subset(pos_annotations, type == "word")
tags <- sapply(pos_words$features, `[[`, "POS")
return(tags)
}))%>% mutate(lyrics_pos=paste(pos_annotation,collapse=" "))
# conta occorrenze di ciascun pos
songs_pos<-data%>% unnest_tokens(pos, lyrics_pos) %>% ungroup()
# considera come gruppo l'anno
# calcola quante volte è stato usato ciascun pos
songs_words<-songs_pos %>% group_by(anno,pos) %>% summarise(count=n())
# per ciascun pos quante volte è stato usato ed in quante canzoni
words<-songs_pos %>% group_by(pos) %>% summarise(count=n(),songs=length(unique(titolo))) %>% arrange(count)
# tutti i pos sono stati usati in tutte le canzoni
# associa il significato a ciascun pos tag
words<-words %>% left_join(pos_tags)## Joining, by = "pos"# ordina i pos nel grafico in base al numero di occorrenze
words$meaning <- factor(words$meaning, levels = words$meaning[order(words$count)])
ggplot(words,aes(x=meaning,y=count))+
geom_col()+
scale_y_log10()+
coord_flip()
# unnest_tokens con token="ngram" non vuole colonne di tipo non atomico
# rimuovi le colonne di tipo list
columnsTypes<-sapply(data,class)
data_sub<-data[,columnsTypes!="list"]
# estrai bigrammi e trigrammi
bigrams<-data_sub%>% unnest_tokens(pos, lyrics_pos,token="ngrams",n=2) %>% ungroup()
trigrams<-data_sub%>% unnest_tokens(pos, lyrics_pos,token="ngrams",n=3) %>% ungroup()
quagrams<-data_sub%>% unnest_tokens(pos, lyrics_pos,token="ngrams",n=4) %>% ungroup()
cigrams<-data_sub%>% unnest_tokens(pos, lyrics_pos,token="ngrams",n=5) %>% ungroup()
ngrams<-bigrams %>% mutate(n=2)%>% rbind(trigrams %>% mutate(n=3)) %>% rbind(quagrams %>% mutate(n=4)) %>% rbind(cigrams %>% mutate(n=5))
# conta quante volte è usato ciascun ngram ed in quante canzoni
words<-ngrams %>% group_by(pos) %>% summarise(count=n(),songs=length(unique(titolo))) %>% arrange(desc(count))
words_plot<-words %>% top_n(20,count)
# associa il significato a ciascun pos tag
words_plot$pos_meaning<-sapply(words_plot$pos,function(pos){
poss<-data.frame(pos=str_split(pos," ") %>% unlist) %>% left_join(pos_tags)
return(poss$meaning %>% paste(collapse="-"))
})## Joining, by = "pos"## Warning: Column `pos` joining factor and character vector, coercing into
## character vector## Joining, by = "pos"## Warning: Column `pos` joining factor and character vector, coercing into
## character vector## Joining, by = "pos"## Warning: Column `pos` joining factor and character vector, coercing into
## character vector## Joining, by = "pos"## Warning: Column `pos` joining factor and character vector, coercing into
## character vector## Joining, by = "pos"## Warning: Column `pos` joining factor and character vector, coercing into
## character vector## Joining, by = "pos"## Warning: Column `pos` joining factor and character vector, coercing into
## character vector## Joining, by = "pos"## Warning: Column `pos` joining factor and character vector, coercing into
## character vector## Joining, by = "pos"## Warning: Column `pos` joining factor and character vector, coercing into
## character vector## Joining, by = "pos"## Warning: Column `pos` joining factor and character vector, coercing into
## character vector## Joining, by = "pos"## Warning: Column `pos` joining factor and character vector, coercing into
## character vector## Joining, by = "pos"## Warning: Column `pos` joining factor and character vector, coercing into
## character vector## Joining, by = "pos"## Warning: Column `pos` joining factor and character vector, coercing into
## character vector## Joining, by = "pos"## Warning: Column `pos` joining factor and character vector, coercing into
## character vector## Joining, by = "pos"## Warning: Column `pos` joining factor and character vector, coercing into
## character vector## Joining, by = "pos"## Warning: Column `pos` joining factor and character vector, coercing into
## character vector## Joining, by = "pos"## Warning: Column `pos` joining factor and character vector, coercing into
## character vector## Joining, by = "pos"## Warning: Column `pos` joining factor and character vector, coercing into
## character vector## Joining, by = "pos"## Warning: Column `pos` joining factor and character vector, coercing into
## character vector## Joining, by = "pos"## Warning: Column `pos` joining factor and character vector, coercing into
## character vector## Joining, by = "pos"## Warning: Column `pos` joining factor and character vector, coercing into
## character vector# ordina i pos nel grafico in base al numero di occorrenze
words_plot$pos_meaning <- factor(words_plot$pos_meaning, levels = words_plot$pos_meaning[order(words_plot$count)])
ggplot(words_plot,aes(x=pos_meaning,y=count))+
geom_col()+
coord_flip()
parole con loro pos tag
# recupera per ogni canzone la parola con corrispondente pos tag
word_pos<-apply(data,1,function(row){
x<-removePunctuation(row$lyrics)
y<-row$annotations
x<-as.String(x)
pos_annotations<-NLP::annotate(x, pos_ann,y) # usa il namespace per evitare problemi di ambiguità
pos_words <- subset(pos_annotations, type == "word")
tags <- sapply(pos_words$features, `[[`, "POS")
return(data.frame(word=x[pos_words],pos_tag=tags,titolo=row$titolo))
})
word_pos<-do.call("rbind",word_pos)
# quante volte è stata usata ciascuna parola e in quante canzoni
# alcne parole sono associate a più pos tag
words %>% nrow## [1] 22777words %>% distinct(word) %>% nrow## [1] 22777# parole e loro pos corrispondenti
word_poss<-word_pos %>% group_by(word) %>% summarise(count=length(unique(pos_tag)),poss=paste(unique(pos_tag),collapse=",")) %>% arrange(desc(count))
# quante parole sono associate a quanti pos
multiple_pos<-word_poss %>% group_by(count) %>% summarise(how_many=n())# considera per ciascuna parola il pos tag più usato (in caso la parola sia associata a più pos tag)
words<-word_pos %>% group_by(word) %>% summarise(count=n(),songs=length(unique(titolo)),pos_tag =names(which.max(table(pos_tag)))) %>% arrange(desc(count))
#rimuovi stopwords
words<-words %>% anti_join(stop_words_ita) %>% filter(nchar(as.character(word))>2)## Joining, by = "word"## Warning: Column `word` joining factors with different levels, coercing to
## character vector# word cloud
# colora in base alla lunghezza delle parole TODO da controllare i colori
lengthValues<-nchar(as.character(words$word))
minlength<-min(lengthValues)
maxlength<-max(lengthValues)
lengthRange<-maxlength-minlength
basecolors <- gray.colors(lengthRange)
colorValues <- basecolors[ lengthValues-minlength ]
# in base a quante volte è stata usata una parola
wordcloud(words$word,words$count,colors=colorValues,max.words = 50)
# in base a quante canzoni hanno usato una parola
wordcloud(words$word,words$songs,colors=colorValues,max.words = 50)
Sentiment analysis
# usa parole positive e negative prese da https://github.com/gragusa/sentiment-lang-italian/blob/master/lexicon/neg.words.txt.gz
p_words<-read_csv("data/pos.words.txt",col_names = c("word"))## Parsed with column specification:
## cols(
## word = col_character()
## )p_words$sentiment<-1 # punteggio +1 per parole positive
n_words<-read_csv("data/neg.words.txt",col_names = c("word"))## Parsed with column specification:
## cols(
## word = col_character()
## )n_words$sentiment<--1 # punteggio -1 per parole negative
# controlla se ci sono parole sia positive che negative
ambiguous_words<-p_words$word %>% intersect(n_words$word)
# non ci sono
# unisci tutte le parole
sentiment_words<-p_words %>% rbind(n_words)
# per ogni canzone numero di parole positive e numero di parole negative (considerando o meno se la parola viene ripetuta)
songs_words<-song_tokens %>% group_by(titolo,word) %>% summarise(count=n())
song_sentiment<-songs_words %>% inner_join(sentiment_words) %>% group_by(titolo,sentiment) %>% summarise(different_sentiment=n(),total_sentiment=sum(count))## Joining, by = "word"# per ogni canzone il grado di positività
song_sentiment<-songs_words %>% inner_join(sentiment_words) %>% group_by(titolo) %>% summarise(positivity=sum(sentiment*count))## Joining, by = "word"# o https://github.com/AndreaCirilloAC/TweetIT/tree/master/lexicon/IT
p_words<-read_csv("data/positive.txt",col_names = c("word"))## Parsed with column specification:
## cols(
## word = col_character()
## )## Warning in rbind(names(probs), probs_f): number of columns of result is not
## a multiple of vector length (arg 2)## Warning: 1 parsing failure.
## row # A tibble: 1 x 5 col row col expected actual file expected <int> <chr> <chr> <chr> <chr> actual 1 1965 <NA> 1 columns 2 columns 'data/positive.txt' file # A tibble: 1 x 5p_words$sentiment<-1 # punteggio +1 per parole positive
n_words<-read_csv("data/negative.txt",col_names = c("word"))## Parsed with column specification:
## cols(
## word = col_character()
## )n_words$sentiment<--1 # punteggio -1 per parole negative
# controlla se ci sono parole sia positive che negative
ambiguous_words<-p_words$word %>% intersect(n_words$word)
# ci sono
# unisci tutte le parole
sentiment_words_2<-p_words %>% rbind(n_words)
song_sentiment<-songs_words %>% inner_join(sentiment_words_2) %>% group_by(titolo,sentiment) %>% summarise(different_sentiment=n(),total_sentiment=sum(count))## Joining, by = "word"# evidenzia canzoni che hanno tante parole positive e anche tante parole negative
# per far questo considera l'opposto del prodotto del punteggio dato dalle parole positive e negative
song_contrast<-song_sentiment %>% group_by(titolo) %>% summarise(contrast=-prod(sentiment*total_sentiment))
song_sentiment<-songs_words %>% inner_join(sentiment_words_2) %>% group_by(titolo) %>% summarise(positivity=sum(sentiment*count),words=paste(word,collapse=","),sentiment=sum(abs(sentiment*count))) %>% arrange(sentiment)## Joining, by = "word"song_sentiment<-song_sentiment %>% inner_join(song_contrast)## Joining, by = "titolo"ggplot(song_sentiment,aes(x=positivity))+
geom_histogram()## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
ggplot(song_sentiment,aes(x=sentiment))+
geom_histogram()## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
ggplot(song_sentiment,aes(x=contrast))+
geom_histogram()## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
pairs(song_sentiment %>% select(positivity,sentiment,contrast))
ggplot(song_sentiment,aes(x=contrast,y=sentiment,color=positivity))+
geom_point()
# ordina i titoli nel grafico in base all'anno
d<-song_sentiment %>% inner_join(sanremo_lyrics,by="titolo") %>% group_by(titolo) %>% filter(row_number()== 1) # filtre titoli doppi
d$titolo <- factor(d$titolo, levels = d$titolo[order(d$anno)])
ggplot(d,aes(x=titolo,y=contrast,fill=positivity)) +
geom_col()+
coord_flip()
Usare le features di spotify
aa<-all_data %>% inner_join(song_sentiment)## Joining, by = "titolo"columnsTypes<-sapply(aa,is.numeric)
data_sub<-aa[,columnsTypes]
pairs(data_sub) 
# all'aumentare degli anni aumenta l'energy e loudness, sembrerebbe anche danceability, inoltre anche track_popularity per un gruppo di canzoni mentre per altre la track popularity indipendentemente dall'anno rimane 0
# c'è una canzone che è molto distante dalle altre per liveness (valore molto grande) (solo noi 1980 toto cotugno)
# per time signature quasi tutte le canzoni sono insieme eccetto alcunevisualizza misure di energy,danceability e loudness rispetto all’anno
data_sub %>% select(anno,energy,danceability,loudness) %>% mutate(loudness=(loudness-min(loudness))/diff(range(data_sub$loudness))) %>% gather(measure,value,-anno) %>%
ggplot(aes(x=anno,y=value,color=measure))+
geom_point()+geom_smooth(method="lm")
visualizza misure di track_popularity rispetto all’anno
aa %>%
ggplot(aes(x=anno,y=track_popularity,color=acousticness))+
geom_point()+geom_smooth(method="lm")+
geom_text(aes(label=titolo))
m<-lm(track_popularity~anno+danceability+energy+loudness+mode+speechiness+acousticness+instrumentalness+liveness+valence+tempo+duration_ms+time_signature+positivity+sentiment+contrast,aa)
m<-lm(contrast~track_popularity+anno+danceability+energy+loudness+mode+speechiness+acousticness+instrumentalness+liveness+valence+tempo+duration_ms+time_signature,aa)thirdValue<-all_data %>% arrange(desc(liveness)) %>% select(liveness) %>% slice(3)
all_data %>%
ggplot(aes(x=anno,y=liveness))+
geom_point()+geom_smooth(method="lm")+
geom_text(data=all_data %>% filter(liveness>=thirdValue[[1]]),aes(label=titolo))
m<-lm(track_popularity~anno+danceability+energy+key+loudness+mode+speechiness+acousticness+instrumentalness+liveness+valence+tempo+duration_ms+time_signature+key_mode,all_data)Topic modelling
library(topicmodels)
lyrics<-all_data$lyrics %>% tolower
ds <- Corpus(VectorSource(lyrics))
binDTM <- DocumentTermMatrix(ds)
songs_words<-song_tokens %>% group_by(titolo,word) %>% summarise(count=n())
ss<-songs_words %>% cast_dtm(titolo, word, count)
ap_lda <- LDA(ss, k = 2, control = list(seed = 1234))
ap_topics <- tidy(ap_lda, matrix = "beta")
ap_topics## # A tibble: 3,966 x 3
## topic term beta
## <int> <chr> <dbl>
## 1 1 alba 2.59e- 4
## 2 2 alba 5.92e-87
## 3 1 amore 2.25e- 2
## 4 2 amore 1.84e- 2
## 5 1 anticipando 2.59e- 4
## 6 2 anticipando 4.29e-87
## 7 1 avra 2.59e- 4
## 8 2 avra 3.29e-87
## 9 1 azzurro 7.76e- 4
## 10 2 azzurro 2.18e-86
## # ... with 3,956 more rowsap_top_terms <- ap_topics %>%
group_by(topic) %>%
top_n(10, beta) %>%
ungroup() %>%
arrange(topic, -beta)
ap_top_terms %>%
mutate(term = reorder(term, beta)) %>%
ggplot(aes(term, beta, fill = factor(topic))) +
geom_col(show.legend = FALSE) +
facet_wrap(~ topic, scales = "free") +
coord_flip()
beta_spread <- ap_topics %>%
mutate(topic = paste0("topic", topic)) %>%
spread(topic, beta) %>%
filter(topic1 > .001 | topic2 > .001) %>%
mutate(log_ratio = log2(topic2 / topic1))Genera il testo di una possibile canzone
library(dplyr)
unigrams<-all_data %>% mutate(lyrics=removePunctuation(lyrics)) %>% unnest_tokens(last_word, lyrics,token="ngrams",n=1) %>% count(last_word)
bigrams<-all_data %>% mutate(lyrics=removePunctuation(lyrics)) %>% unnest_tokens(word, lyrics,token="ngrams",n=2) %>% separate(word, c("word1", "last_word"), sep = " ") %>% count(word1, last_word, sort = TRUE)
trigrams<-all_data %>% mutate(lyrics=removePunctuation(lyrics)) %>% unnest_tokens(word, lyrics,token="ngrams",n=3) %>% separate(word, c("word1", "word2", "last_word"), sep = " ") %>% count(word1, word2,last_word, sort = TRUE)
quagrams<-all_data %>% mutate(lyrics=removePunctuation(lyrics)) %>% unnest_tokens(word, lyrics,token="ngrams",n=4) %>% separate(word, c("word1", "word2", "word3", "last_word"), sep = " ") %>% count(word1, word2,word3,last_word, sort = TRUE)
get_second_word <- function( word1Val){
result <- filter_(bigrams, ~word1 == word1Val) %>% sample_n(1, weight = n, replace=T)
if(nrow(result) < 1){
result <- unigrams
}
result<- result %>% sample_n(1, weight = n, replace=T) %>% .[["last_word"]]
return(result)
}
get_third_word <- function( word1Val, word2Val){
result <- trigrams %>% filter_(~word1 == word1Val, ~word2 == word2Val)
if(nrow(result) < 1){
result<-get_second_word(word2Val)
}else{
result<- result %>% sample_n(1, weight = n, replace=T) %>% .[["last_word"]]
}
return(result)
}
get_fourth_word <- function( word1Val, word2Val, word3Val){
result <- quagrams %>% filter_(~word1 == word1Val, ~word2 == word2Val, ~word3 == word3Val)
if(nrow(result) < 1){
result<-get_third_word(word2Val,word3Val)
}else{
result<- result %>% sample_n(1, weight = n, replace=T) %>% .[["last_word"]]
}
return(result)
}
get_song <- function(word1,sentencelength =5){
sentence <- character(sentencelength)
sentence[1]<-word1
word2<-get_second_word(word1)
word3<-get_third_word(word1,word2)
sentence[2]<-word2
sentence[3]<-word3
for(i in seq_len(sentencelength-3)){
word <- get_fourth_word( word1, word2, word3)
sentence[i+3] <- word
word1 <- word2
word2 <- word3
word3<-word
}
return(paste(sentence, collapse = " "))
}
set.seed(1234)
# spezza il testo in singole parole
song_tokens<-all_data %>% unnest_tokens(word, lyrics) %>% ungroup()
# considera come gruppo l'anno
# per ogni anno quante parole totali sono apparse e quante parole diverse sono state usate
songs_words<-song_tokens %>% group_by(word,anno) %>% summarise(count=n())
total_words<-getWordsCount(songs_words %>% mutate(songId=anno)) %>% sample_n(1,replace = T) %>% .[["total_words"]]
word1<-unigrams %>% sample_n(1,weight = n,replace = T) %>% .[["last_word"]]
lyrics<-get_song(word1,total_words)
cat(lyrics)## io compongo nuovi spazi e desideri che appartengono anche a te che sei bella da morire tutto sembra un film da girare troppo in fretta con la fine sopra i tuoi bluejeans e sei bella da morire ragazzina tu sul tuo seno da rubare io non gioco piu e sei bella da morire tutto sembra un film da girare troppo in fretta con la fine sopra i tuoi bluejeans a sedici anni non si perde il cuore nemmeno quando provi a far l amore in tutti i laghi in tutto il mondo l universo che ci si insegue ma ormai siamo irraggiungibili mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm mm